HGamer3D 0.1.10 → 0.2.0
raw patch · 15 files changed
+860/−226 lines, 15 filesdep +HGamer3D-Bullet-Bindingdep +HGamer3D-Enet-Bindingdep ~HGamer3D-CEGUI-Bindingdep ~HGamer3D-Datadep ~HGamer3D-Ogre-Binding
Dependencies added: HGamer3D-Bullet-Binding, HGamer3D-Enet-Binding
Dependency ranges changed: HGamer3D-CEGUI-Binding, HGamer3D-Data, HGamer3D-Ogre-Binding, HGamer3D-SFML-Binding
Files
- HGamer3D.cabal +5/−5
- HGamer3D/APIs/Base/Audio/Audio.hs +101/−46
- HGamer3D/APIs/Base/Engine/Engine.hs +49/−28
- HGamer3D/APIs/Base/Engine/Types.hs +23/−9
- HGamer3D/APIs/Base/GUI/BasicGUI.hs +110/−90
- HGamer3D/APIs/Base/GUI/EngineHelper.hs +8/−3
- HGamer3D/APIs/Base/Graphics3D/Basic3D.hs +18/−6
- HGamer3D/APIs/Base/Graphics3D/Light.hs +40/−14
- HGamer3D/APIs/Base/Graphics3D/Object3D.hs +58/−20
- HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs +6/−4
- HGamer3D/APIs/Base/Network/EngineHelper.hs +53/−0
- HGamer3D/APIs/Base/Network/Network.hs +143/−0
- HGamer3D/APIs/Base/Physics/EngineHelper.hs +59/−0
- HGamer3D/APIs/Base/Physics/Physics.hs +181/−0
- HGamer3D/BaseAPI.hs +6/−1
HGamer3D.cabal view
@@ -1,5 +1,5 @@ Name: HGamer3D -Version: 0.1.10 +Version: 0.2.0 Synopsis: Windows Game Engine for the Haskell Programmer Description: HGamer3D is a game engine for developing 3D games in the programming @@ -13,15 +13,15 @@ Author: Peter Althainz Maintainer: althainz@gmail.com Build-Type: Simple -Cabal-Version: >=1.2 +Cabal-Version: >=1.4 Homepage: http://www.hgamer3d.org -Category: Game +Category: Game Engine Extra-source-files: Setup.hs Library - 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 + Build-Depends: base >= 3 && < 5, containers, text, directory, Win32, mtl, FindBin, HGamer3D-Data >= 0.2.0, HGamer3D-Ogre-Binding == 0.2.0, HGamer3D-SFML-Binding == 0.2.0, HGamer3D-CEGUI-Binding == 0.2.0, HGamer3D-Bullet-Binding == 0.2.0, HGamer3D-Enet-Binding == 0.2.0 - 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 + 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,HGamer3D.APIs.Base.Network.EngineHelper,HGamer3D.APIs.Base.Network.Network,HGamer3D.APIs.Base.Physics.EngineHelper,HGamer3D.APIs.Base.Physics.Physics Other-modules: c-sources:
HGamer3D/APIs/Base/Audio/Audio.hs view
@@ -35,8 +35,8 @@ AudioSource (..), -- Listener Functions- setAudioListenerVolume,- getAudioListenerVolume,+ setAudioMainVolume,+ getAudioMainVolume, setAudioListenerPosition, setAudioListenerDirection, @@ -54,18 +54,23 @@ getAudioSourceLoop, -- Source Functions- setAudioSourcePitch,+ getAudioSourceVolume, setAudioSourceVolume,++ getAudioSourcePitch,+ setAudioSourcePitch,++ getAudioSourcePosition, setAudioSourcePosition,++ getAudioSourceAttenuation, setAudioSourceAttenuation, - getAudioSourcePitch,- getAudioSourceVolume, getAudioSourceMinDistance,- getAudioSourceAttenuation,+ setAudioSourceMinDistance, - attachAudioSourceToListener,- isAudioSourceAttachedToListener,+ setAudioSourcePositionDependent,+ isAudioSourcePositionDependent, ) @@ -98,15 +103,21 @@ -- Listener Functions -setAudioListenerVolume :: Float -> MHGamer3D ()-setAudioListenerVolume vol = liftIO $ Listener.setGlobalVolume vol+-- | set overall main audio volume+setAudioMainVolume :: Float -- ^volume in a scale between 0 and 100.0+ -> MHGamer3D ()+setAudioMainVolume vol = liftIO $ Listener.setGlobalVolume vol -getAudioListenerVolume :: MHGamer3D Float-getAudioListenerVolume = liftIO $ Listener.getGlobalVolume+-- | get overall main audio volume+getAudioMainVolume :: MHGamer3D Float+getAudioMainVolume = liftIO $ Listener.getGlobalVolume -setAudioListenerPosition :: Vec3 -> MHGamer3D ()+-- | set position of the listener, this is where the "micro" is located+setAudioListenerPosition :: Vec3 -- ^position of listener+ -> MHGamer3D () setAudioListenerPosition (Vec3 x y z) = liftIO $ Listener.setPosition x y z +-- | set direction of the listener, this is in which direction the listener hears setAudioListenerDirection :: Vec3 -> MHGamer3D () setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z @@ -114,11 +125,13 @@ -- Music Functions, deletion and cretion of Audio types -- --- | Creates music with name-createMusic :: String -> MHGamer3D (Maybe AudioSource)+-- | create music with filename, music is buffered stream+createMusic :: String -- ^filename of music without path+ -> MHGamer3D (Maybe AudioSource) -- ^audio source, which can be played createMusic filename = do music <- liftIO $ Music.new- (cs, es, gs) <- ask+ rs <- ask+ let cs = commonSystem rs let dir = (csHG3DPath cs) let progdir = (csProgPath cs) -- first try in runtime folder@@ -133,12 +146,14 @@ liftIO $ Music.delete music return Nothing --createSound :: String -> MHGamer3D (Maybe AudioSource)+-- | create sound with filename, sound is not buffered but loaded completely into memory+createSound :: String -- ^filename of sound without path+ -> MHGamer3D (Maybe AudioSource) -- ^audio source, which can be played createSound filename = do sound <- liftIO $ Sound.new buffer <- liftIO $ SoundBuffer.new- (cs, es, gs) <- ask+ rs <- ask+ let cs = commonSystem rs let dir = (csHG3DPath cs) let progdir = (csProgPath cs) fOk <- liftIO $ SoundBuffer.loadFromFile buffer (dir ++ "\\media\\sound\\" ++ filename)@@ -166,25 +181,31 @@ -- Source play, pause, stop -- -playAudioSource :: AudioSource -> MHGamer3D ()+-- | starts playing audio, which can be music or sound+playAudioSource :: AudioSource -- ^the audio source+ -> MHGamer3D () playAudioSource (Music music) = do liftIO $ SoundStream.play music playAudioSource (Sound sound buffer) = do liftIO $ Sound.play sound +-- | pause playing audio, remembers location pauseAudioSource :: AudioSource -> MHGamer3D () pauseAudioSource (Music music) = do liftIO $ SoundStream.pause music pauseAudioSource (Sound sound buffer) = do liftIO $ Sound.pause sound +-- | completely stops audio playing stopAudioSource :: AudioSource -> MHGamer3D () stopAudioSource (Music music) = do liftIO $ SoundStream.stop music stopAudioSource (Sound sound buffer) = do liftIO $ Sound.stop sound -getAudioSourceLoop :: AudioSource -> MHGamer3D Bool+-- | is audio play looping+getAudioSourceLoop :: AudioSource -- ^audio source+ -> MHGamer3D Bool -- ^true, loop is enabled, false loop is disabled getAudioSourceLoop (Music music) = do fLoop <- liftIO $ SoundStream.getLoop music return fLoop@@ -192,7 +213,10 @@ fLoop <- liftIO $ Sound.getLoop sound return fLoop -setAudioSourceLoop :: AudioSource -> Bool -> MHGamer3D ()+-- | set audio play is looping+setAudioSourceLoop :: AudioSource -- ^audio source+ -> Bool -- ^loop enabled+ -> MHGamer3D () setAudioSourceLoop (Music music) fLoop = do liftIO $ SoundStream.setLoop music fLoop setAudioSourceLoop (Sound sound buffer) fLoop = do@@ -202,45 +226,76 @@ -- 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+-- | get volume of a single audio source+getAudioSourceVolume :: AudioSource -- ^audio source+ -> MHGamer3D Float -- ^volume of audio source in scale of 0 to 100.0+ +getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s+getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s -setAudioSourceVolume :: AudioSource -> Float -> MHGamer3D ()+-- | set volume of a single audio source+setAudioSourceVolume :: AudioSource -- ^audio source+ -> Float -> MHGamer3D () -- ^volume of this audio source in scale of 0 to 100.0+ setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v -setAudioSourcePosition :: AudioSource -> Vec3 -> MHGamer3D ()+-- | get audio source pitch, the pitch is the frequency of the sound which also influences playing speed. The default value is 1.0.+getAudioSourcePitch :: AudioSource -- ^audio source+ -> MHGamer3D Float -- ^pitch, a 1.0 is no change to original sound+ +getAudioSourcePitch (Music s) = liftIO $ SoundSource.getPitch s+getAudioSourcePitch (Sound s b) = liftIO $ SoundSource.getPitch s++-- | sets the pitch of an audio source+setAudioSourcePitch :: AudioSource -> Float -> MHGamer3D ()+setAudioSourcePitch (Music s) p = liftIO $ SoundSource.setPitch s p+setAudioSourcePitch (Sound s b) p = liftIO $ SoundSource.setPitch s p++-- | sets the position of an audio source+setAudioSourcePosition :: AudioSource -- ^audio source+ -> Vec3 -> MHGamer3D () -- ^new position of this source+ 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+-- | gets the position of an audio source+getAudioSourcePosition :: AudioSource -- ^audio source+ -> MHGamer3D Vec3 -- ^position of the audio source+ +getAudioSourcePosition (Music s) = liftIO $ SoundSource.getPosition s+getAudioSourcePosition (Sound s b) = liftIO $ SoundSource.getPosition s +-- | gets the attenuation factor of an audio source+getAudioSourceAttenuation :: AudioSource -- ^audio source+ -> MHGamer3D Float -- ^attenuation is the damping factor by distance, default value is 1.0, 0.0 means no damping+getAudioSourceAttenuation (Music s) = liftIO $ SoundSource.getAttenuation s+getAudioSourceAttenuation (Sound s b) = liftIO $ SoundSource.getAttenuation s -getAudioSourceVolume :: AudioSource -> MHGamer3D Float-getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s-getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s+-- | sets the attenuation factor of an audio source+setAudioSourceAttenuation :: AudioSource -- ^audio source+ -> Float -> MHGamer3D () -- ^attenuation factor+setAudioSourceAttenuation (Music s) a = liftIO $ SoundSource.setAttenuation s a+setAudioSourceAttenuation (Sound s b) a = liftIO $ SoundSource.setAttenuation s a +-- | gets audio source min distance, distance at which sound is played a volume 100.0 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+-- | sets audio source min distance, distance at which sound is played a volume 100.0+setAudioSourceMinDistance :: AudioSource -> Float -> MHGamer3D ()+setAudioSourceMinDistance (Music s) d = liftIO $ SoundSource.setMinDistance s d+setAudioSourceMinDistance (Sound s b) d = liftIO $ SoundSource.setMinDistance s d -attachAudioSourceToListener :: AudioSource -> Bool -> MHGamer3D ()-attachAudioSourceToListener (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR-attachAudioSourceToListener (Sound s b) isR = liftIO $ SoundSource.setRelativeToListener s isR+-- | set flag if audio source depends on position, default is FALSE (not dependent on position)+setAudioSourcePositionDependent :: AudioSource -> Bool -> MHGamer3D ()+setAudioSourcePositionDependent (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR+setAudioSourcePositionDependent (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+-- | get flag if audio source depends on position, default is FALSE (not dependent on position)+isAudioSourcePositionDependent :: AudioSource -> MHGamer3D Bool+isAudioSourcePositionDependent (Music s) = liftIO $ SoundSource.isRelativeToListener s+isAudioSourcePositionDependent (Sound s b) = liftIO $ SoundSource.isRelativeToListener s
HGamer3D/APIs/Base/Engine/Engine.hs view
@@ -25,14 +25,14 @@ module HGamer3D.APIs.Base.Engine.Engine ( getUniqueName,- mapFunctionToFunctionTag,- getFunctionFromFunctionTag,+ mapFunctionToTag,+ getFunctionFromTag, initCommonSystem, getTimeMS, runMHGamer3D, initHGamer3D,- + createEventMap, renderLoop ) @@ -59,6 +59,8 @@ import HGamer3D.APIs.Base.Graphics3D.EngineHelper import HGamer3D.APIs.Base.GUI.EngineHelper+import HGamer3D.APIs.Base.Network.EngineHelper+import HGamer3D.APIs.Base.Physics.EngineHelper import Control.Monad import Control.Monad.Trans@@ -78,25 +80,24 @@ -- identification dll -- hg3ddllname :: String-hg3ddllname = "HGamer3D-Version-0.1.9-DontDelete.txt"+hg3ddllname = "HGamer3D-Version-0.2.0-DontDelete.txt" -- unique identifiers, by appending a unique integer to a prefix getUniqueName :: String -> MHGamer3D String getUniqueName prefix = do - HG3DEngineState (x:xs) <- lift get+ 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-+mapFunctionToTag :: EventFunction worldState -> String -> EventMap worldState -> EventMap worldState+mapFunctionToTag function tag eventMap = Map.insert tag function eventMap+ +getFunctionFromTag :: String -> EventMap worldState -> Maybe (EventFunction worldState)+getFunctionFromTag tag eventMap = Map.lookup tag eventMap -- function, which finds installation path of HG3D --@@ -125,10 +126,10 @@ return (TimeMS $ fromIntegral (wt * 1000 `div` fr)) -runMHGamer3D :: MHGamer3DState -> MHGamer3D a -> IO (a, MHGamer3DState)-runMHGamer3D (MHGamer3DState readerstate enginestate) action = do+runMHGamer3D :: (HG3DReaderState, HG3DEngineState) -> MHGamer3D a -> IO (a, (HG3DReaderState, HG3DEngineState))+runMHGamer3D (readerstate, enginestate) action = do (actionResult, newEnginestate) <- runStateT (runReaderT action readerstate ) enginestate- return (actionResult, MHGamer3DState readerstate newEnginestate)+ return (actionResult, (readerstate, newEnginestate)) data MouseState = MouseUp | MouseDown deriving (Eq) @@ -145,7 +146,7 @@ return (TimeMouseState ms tms) -initHGamer3D :: String -> IO MHGamer3DState+initHGamer3D :: String -> IO (HG3DReaderState, HG3DEngineState) initHGamer3D windowName = do -- init Commons configs@@ -164,15 +165,27 @@ -- init GUI configs and engine gui <- initGUIEngine fLog - let state = HG3DEngineState [1..] - return (MHGamer3DState (cs, g3s, gui) state)+ -- init Network engine+ network <- initNetworkEngine + -- init Phyiscs engine+ physics <- initPhysicsEngine+ + + let enginestate = HG3DEngineState [1..]+ let readerstate = HG3DReaderState cs g3s gui network physics+ + return (readerstate, enginestate)+ -- 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+ rs <- ask+ let cs = commonSystem rs+ let g3s = graphics3DSystem rs+ let gui = guiSystem rs -- adapt to framerate, while still doing messagePump (TimeMS time) <- getTimeMS let delta = time - lastTime@@ -197,12 +210,12 @@ 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+ liftIO $ CEGUISystem.injectMouseButtonDown (guiGUI gui) CEGUIButton.MouseLeftButton return () else do return () if lastMouseState == MouseDown && ms == MouseUp then do- liftIO $ CEGUISystem.injectMouseButtonUp (guiSystem gui) CEGUIButton.MouseLeftButton+ liftIO $ CEGUISystem.injectMouseButtonUp (guiGUI gui) CEGUIButton.MouseLeftButton return () else do return ()@@ -218,12 +231,12 @@ let mouseX = xm - left - offLeft let mouseY = ym - top - offRight- liftIO $ CEGUISystem.injectMousePosition (guiSystem gui) (fromIntegral mouseX) (fromIntegral mouseY)+ liftIO $ CEGUISystem.injectMousePosition (guiGUI gui) (fromIntegral mouseX) (fromIntegral mouseY) -- time pulse injection- liftIO $ CEGUISystem.injectTimePulse (guiSystem gui) delta2+ liftIO $ CEGUISystem.injectTimePulse (guiGUI gui) delta2 -- display 3D and GUI liftIO $ Root.renderOneFrame (g3sRoot g3s)- liftIO $ CEGUISystem.renderGUI (guiSystem gui)+ liftIO $ CEGUISystem.renderGUI (guiGUI gui) return (True, (TimeMouseState ms (TimeMS time)) ) @@ -240,8 +253,13 @@ 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+ +createEventMap :: EventMap worldState+createEventMap = Map.fromList ([]::[(String, EventFunction worldState)])++renderLoop :: Int -> EventMap worldState -> worldState -> (TimeMS -> worldState -> MHGamer3D (Bool, worldState)) -> MHGamer3D ()+renderLoop frameRate eventMap gamestate renderStep = do+ rs <- initTimeMouseState renderInternalLoop frameRate rs gamestate eventMap renderStep @@ -249,14 +267,17 @@ getEventsFromGui :: a -> EventMap a -> MHGamer3D a getEventsFromGui a eventMap = do- (cs, es, gs) <- ask- let eventController = guiEventController gs+ rs <- ask+ let cs = commonSystem rs+ let g3s = graphics3DSystem rs+ let gui = guiSystem rs+ let eventController = guiEventController gui 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+ let evtfunc = getFunctionFromTag name eventMap innera <- case evtfunc of Just func -> do fa <- func evt a
HGamer3D/APIs/Base/Engine/Types.hs view
@@ -32,11 +32,12 @@ CommonSystem (..), Graphics3DSystem (..), GUISystem (..),+ NetworkSystem (..),+ PhysicsSystem (..), HG3DReaderState (..), HG3DEngineState (..), - MHGamer3DState (..), TimeMS (..), ) @@ -68,28 +69,41 @@ data GUISystem = GUISystem { guiRenderer::HG3DClass,- guiSystem::HG3DClass,+ guiGUI::HG3DClass, guiWindowManager::HG3DClass,+ guiWindowManagerHG3D::HG3DClass, guiFontManager::HG3DClass, guiSchemeManager::HG3DClass, guiEventController::HG3DClass } -data Event = GUIEvent String String HG3DClass -- name sender window+data NetworkSystem = NetworkSystem {+ nsNetwork::HG3DClass+} -type EventFunction a = Event -> a -> MHGamer3D a-type EventMap a = Map.Map String (EventFunction a)+data PhysicsSystem = PhysicsSystem {+ psPhysics::HG3DClass,+ psWorld::HG3DClass+} -type HG3DReaderState = (CommonSystem, Graphics3DSystem, GUISystem)+data HG3DReaderState = HG3DReaderState {+ commonSystem::CommonSystem,+ graphics3DSystem::Graphics3DSystem,+ guiSystem::GUISystem,+ networkSystem::NetworkSystem,+ physicsSystem::PhysicsSystem+} +data Event = GUIEvent String String HG3DClass -- name sender window++type EventFunction worldState = Event -> worldState -> MHGamer3D worldState+type EventMap worldState = Map.Map String (EventFunction worldState)+ 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
HGamer3D/APIs/Base/GUI/BasicGUI.hs view
@@ -25,30 +25,36 @@ module HGamer3D.APIs.Base.GUI.BasicGUI (- loadWindowFromFile,- addWindowToDisplay,- removeWindowFromDisplay,+ GUIElement (..), - enableWindow,- disableWindow,- activateWindow,- deactivateWindow,- showWindow,- hideWindow,+ loadGuiLayoutFromFile,+ addGuiElToDisplay,+ removeGuiElFromDisplay, - getChildWindow,- findChildWindowRecursive,- getWindowProperty,- setWindowProperty,+ enableGuiEl,+ disableGuiEl,+ activateGuiEl,+ deactivateGuiEl,+ showGuiEl,+ hideGuiEl, - loadScheme,- loadFont,- HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultFont,- setDefaultMouseCursor,- HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultTooltip,+ getChildGuiEl,+ findChildGuiElRecursive,+ getGuiElProperty,+ setGuiElProperty, - mapGUIEventToFunctionTag,- mapGUIEventToFunction+ loadGuiScheme,+ loadGuiFont,+ setGuiDefaultFont,+ setGuiDefaultMouseCursor,+ setGuiDefaultTooltip,+ + listboxAddText,+ comboboxAddText,+ + mapGuiElEventToFunction,+ + ) where@@ -68,120 +74,134 @@ import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF +import HGamer3D.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF+import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF import HGamer3D.Data.HG3DClass import Control.Monad.Trans import Control.Monad.Reader import HGamer3D.Data.Vector +data GUIElement = GUIElement HG3DClass -loadWindowFromFile :: String -> String -> MHGamer3D (HG3DClass)-loadWindowFromFile layoutFile prefix = do- (cs, g3s, gui) <- ask- hg3dWinMgr <- liftIO $ WindowManagerHG3D.new+loadGuiLayoutFromFile :: String -> String -> MHGamer3D GUIElement+loadGuiLayoutFromFile layoutFile prefix = do+ rs <- ask+ let gui = guiSystem rs+ let hg3dWinMgr = guiWindowManagerHG3D gui window <- liftIO $ WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix- liftIO $ WindowManagerHG3D.delete hg3dWinMgr- return (window)+ return (GUIElement window) -addWindowToDisplay :: HG3DClass -> MHGamer3D ()-addWindowToDisplay window = do- (cs, g3s, gui) <- ask- guiSheet <- liftIO $ System.getGUISheet (guiSystem gui)+addGuiElToDisplay :: GUIElement -> MHGamer3D ()+addGuiElToDisplay (GUIElement window) = do+ rs <- ask+ let gui = guiSystem rs+ let guiS = guiGUI gui+ guiSheet <- liftIO $ System.getGUISheet guiS liftIO $ Window.addChildWindow2 guiSheet window -removeWindowFromDisplay :: HG3DClass -> MHGamer3D ()-removeWindowFromDisplay window = do- (cs, g3s, gui) <- ask- guiSheet <- liftIO $ System.getGUISheet (guiSystem gui)+removeGuiElFromDisplay :: GUIElement -> MHGamer3D ()+removeGuiElFromDisplay (GUIElement window) = do+ rs <- ask+ let gui = guiSystem rs+ let guiS = guiGUI gui+ guiSheet <- liftIO $ System.getGUISheet guiS liftIO $ Window.removeChildWindow2 guiSheet window -enableWindow :: HG3DClass -> MHGamer3D ()-enableWindow window = do- (cs, g3s, gui) <- ask+enableGuiEl :: GUIElement -> MHGamer3D ()+enableGuiEl (GUIElement window) = do liftIO $ Window.enable window -disableWindow :: HG3DClass -> MHGamer3D ()-disableWindow window = do- (cs, g3s, gui) <- ask+disableGuiEl :: GUIElement -> MHGamer3D ()+disableGuiEl (GUIElement window) = do liftIO $ Window.disable window -activateWindow :: HG3DClass -> MHGamer3D ()-activateWindow window = do- (cs, g3s, gui) <- ask+activateGuiEl :: GUIElement -> MHGamer3D ()+activateGuiEl (GUIElement window) = do liftIO $ Window.activate window -deactivateWindow :: HG3DClass -> MHGamer3D ()-deactivateWindow window = do- (cs, g3s, gui) <- ask+deactivateGuiEl :: GUIElement -> MHGamer3D ()+deactivateGuiEl (GUIElement window) = do liftIO $ Window.deactivate window -showWindow :: HG3DClass -> MHGamer3D ()-showWindow window = do- (cs, g3s, gui) <- ask+showGuiEl :: GUIElement -> MHGamer3D ()+showGuiEl (GUIElement window) = do liftIO $ Window.show window -hideWindow :: HG3DClass -> MHGamer3D ()-hideWindow window = do- (cs, g3s, gui) <- ask+hideGuiEl :: GUIElement -> MHGamer3D ()+hideGuiEl (GUIElement window) = do liftIO $ Window.hide window -getChildWindow :: HG3DClass -> String -> MHGamer3D HG3DClass-getChildWindow window name = do+getChildGuiEl :: GUIElement -> String -> MHGamer3D GUIElement+getChildGuiEl (GUIElement window) name = do window <- liftIO $ Window.getChild window name- return window+ return (GUIElement window) -findChildWindowRecursive :: HG3DClass -> String -> MHGamer3D (Maybe HG3DClass)-findChildWindowRecursive window name = do+findChildGuiElRecursive :: GUIElement -> String -> MHGamer3D (Maybe GUIElement)+findChildGuiElRecursive (GUIElement window) name = do window <- liftIO $ Window.getChildRecursive window name if (ocPtr window) == nullPtr then do return Nothing else do- return (Just window)+ return (Just (GUIElement window)) -getWindowProperty :: HG3DClass -> String -> MHGamer3D String-getWindowProperty window name = do+getGuiElProperty :: GUIElement -> String -> MHGamer3D String+getGuiElProperty (GUIElement window) name = do prop <- liftIO $ PropertySet.getProperty window name return prop -setWindowProperty :: HG3DClass -> String -> String -> MHGamer3D ()-setWindowProperty window name value = do+setGuiElProperty :: GUIElement -> String -> String -> MHGamer3D ()+setGuiElProperty (GUIElement window) name value = do liftIO $ PropertySet.setProperty window name value -loadScheme :: String -> MHGamer3D ()-loadScheme schemeName = do- (cs, g3s, gui) <- ask+loadGuiScheme :: String -> MHGamer3D ()+loadGuiScheme schemeName = do+ rs <- ask+ let gui = guiSystem rs liftIO $ SystemHG3D.schemeManagerCreate (guiSchemeManager gui) schemeName -loadFont :: String -> MHGamer3D () -loadFont fontName = do- (cs, g3s, gui) <- ask+loadGuiFont :: String -> MHGamer3D () +loadGuiFont fontName = do+ rs <- ask+ let gui = guiSystem rs liftIO $ SystemHG3D.fontManagerCreate (guiFontManager gui) fontName -setDefaultFont :: String -> MHGamer3D () -setDefaultFont fontName = do- (cs, g3s, gui) <- ask- liftIO $ System.setDefaultFont (guiSystem gui) fontName+setGuiDefaultFont :: String -> MHGamer3D () +setGuiDefaultFont fontName = do+ rs <- ask+ let gui = guiSystem rs+ let guiS = guiGUI gui+ liftIO $ System.setDefaultFont guiS 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+setGuiDefaultMouseCursor :: String -> String -> MHGamer3D () +setGuiDefaultMouseCursor schemeName cursorName = do+ rs <- ask+ let gui = guiSystem rs+ let guiS = guiGUI gui+ liftIO $ System.setDefaultMouseCursor3 guiS schemeName cursorName -mapGUIEventToFunctionTag :: Event -> String -> MHGamer3D ()-mapGUIEventToFunctionTag event functionTag = do- case event of- GUIEvent name sender window -> do- liftIO $ EvtSF.subscribeScriptedEvent window name functionTag- return ()+setGuiDefaultTooltip :: String -> MHGamer3D () +setGuiDefaultTooltip ttName = do+ rs <- ask+ let gui = guiSystem rs+ let guiS = guiGUI gui+ liftIO $ System.setDefaultTooltip2 guiS ttName -mapGUIEventToFunction :: HG3DClass -> String -> EventFunction a -> EventMap a -> MHGamer3D (EventMap a)-mapGUIEventToFunction window eventName function eventMap = do+mapGuiElEventToFunction :: GUIElement -> String -> EventFunction a -> EventMap a -> MHGamer3D (EventMap a)+mapGuiElEventToFunction (GUIElement window) eventName function eventMap = do functionTag <- getUniqueName "Event"- let newmap = mapFunctionToFunctionTag function functionTag eventMap+ let newmap = mapFunctionToTag function functionTag eventMap liftIO $ EvtSF.subscribeScriptedEvent window eventName functionTag return newmap++comboboxAddText :: GUIElement -> String -> MHGamer3D ()+comboboxAddText (GUIElement window) itemname = do+ realcombo <- liftIO $ WindowSF.castWindowToCombobox window+ liftIO $ ListboxSF.comboboxAddItem realcombo itemname+ +listboxAddText :: GUIElement -> String -> MHGamer3D ()+listboxAddText (GUIElement window) itemname = do+ reallistbox <- liftIO $ WindowSF.castWindowToListbox window+ liftIO $ ListboxSF.listboxAddItem reallistbox itemname+ +
HGamer3D/APIs/Base/GUI/EngineHelper.hs view
@@ -58,6 +58,7 @@ import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController+import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as HG3DWindowManager import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump @@ -118,16 +119,20 @@ eventController <- HG3DEventController.new - return (GUISystem guirenderer guisystem guiwindowmgr guifontmgr guischememgr eventController)+ guiwmgrhg3d <- HG3DWindowManager.new+ + return (GUISystem guirenderer guisystem guiwindowmgr guiwmgrhg3d guifontmgr guischememgr eventController) -- keypressInject keypressInject :: MHGamer3D () keypressInject = do- (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs+ let gui = guiSystem rs+ let gSystem = guiGUI gui let messagePump = g3sMessagePump g3s- let gSystem = guiSystem gui processEvents <- liftIO $ MessagePump.eventsPending messagePump if processEvents then do
HGamer3D/APIs/Base/Graphics3D/Basic3D.hs view
@@ -31,6 +31,7 @@ Orientation3D (..), Camera (..),+ HGamer3D.APIs.Base.Graphics3D.Basic3D.getCamera, cameraLookAt, HGamer3D.APIs.Base.Graphics3D.Basic3D.setBackgroundColour,@@ -92,7 +93,8 @@ getCamera :: MHGamer3D Camera getCamera = do- (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs let cam = Camera (g3sCamera g3s) return cam @@ -130,12 +132,14 @@ liftIO $ Camera.lookAt c v return () + -- specific single function -- setBackgroundColour :: Colour -> MHGamer3D () setBackgroundColour bgColour = do- (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs liftIO $ Viewport.setBackgroundColour (g3sViewport g3s) bgColour -- locations of media in same folder as program resides@@ -143,28 +147,36 @@ addResourceLocationMedia :: String -> MHGamer3D () addResourceLocationMedia path = do- (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs+ let cs = commonSystem rs 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+ rs <- ask+ let g3s = graphics3DSystem rs+ let cs = commonSystem rs 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+ rs <- ask+ let g3s = graphics3DSystem rs+ let cs = commonSystem rs 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+ rs <- ask+ let g3s = graphics3DSystem rs+ let cs = commonSystem rs let rgm = g3sResourceGroupManager g3s liftIO $ ResourceGroupManager.initialiseAllResourceGroups rgm
HGamer3D/APIs/Base/Graphics3D/Light.hs view
@@ -26,8 +26,9 @@ Light (..), HGamer3D.APIs.Base.Graphics3D.Light.setAmbientLight, - createPointLight, - createSpotLight, + createPointlight, + createSpotlight, + setSpotlightAngle, createDirectionalLight ) @@ -112,51 +113,76 @@ -- | creates a light, which fills all the room with similar strength setAmbientLight :: Colour -> MHGamer3D () setAmbientLight colour = do - (cs, g3s, gui) <- ask + rs <- ask + let g3s = graphics3DSystem rs liftIO $ SceneManager.setAmbientLight (g3sSceneManager g3s) colour return () -- | creates a point light at a specific location -createPointLight :: Colour -- ^Color of the light +createPointlight :: Colour -- ^Color of the light -> Vec3 -- ^Position, where light is created -> MHGamer3D (Light) -- ^Return value is a graphics object -createPointLight colour (Vec3 x y z) = do - (cs, g3s, gui) <- ask +createPointlight (Colour t r g b) (Vec3 x y z) = do + rs <- ask + let g3s = graphics3DSystem rs lightName <- getUniqueName "LO" light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName - liftIO $ Light.setType light LT_DIRECTIONAL + liftIO $ Light.setType light LT_POINT liftIO $ Light.setPosition light x y z + liftIO $ Light.setDiffuseColour light r g b + liftIO $ Light.setSpecularColour light r g b let eo = Light light return eo --- | creates a point light at a specific location -createSpotLight :: Colour -- ^Color of the light +-- | creates a spot light at a specific location +createSpotlight :: Colour -- ^Color of the light -> Vec3 -- ^Position, where light is created -> MHGamer3D (Light) -- ^Return value is a graphics object -createSpotLight colour (Vec3 x y z) = do - (cs, g3s, gui) <- ask +createSpotlight (Colour t r g b) (Vec3 x y z) = do + rs <- ask + let g3s = graphics3DSystem rs lightName <- getUniqueName "LO" light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_SPOTLIGHT liftIO $ Light.setPosition light x y z + liftIO $ Light.setDiffuseColour light r g b + liftIO $ Light.setSpecularColour light r g b let eo = Light light return eo +-- | set the angle of a spotlight +setSpotlightAngle :: Light -- ^spotlight + -> Angle -- ^angle of the light cone, should be between 5 and 355 degree + -> MHGamer3D () +setSpotlightAngle (Light light) a = do + if (a >= (Deg 5)) && (a <= (Deg 355)) + then do + let innerAngle = fromAngle $ a `subA` (Deg 4.5) + let outerAngle = fromAngle $ a `addA` (Deg 4.5) + liftIO $ Light.setSpotlightInnerAngle light innerAngle + liftIO $ Light.setSpotlightOuterAngle light outerAngle + return () + else do + return () + --- | creates a point light at a specific location +-- | creates a directional light at a specific location createDirectionalLight :: Colour -- ^Color of the light -> Vec3 -- ^Position, where light is created -> MHGamer3D (Light) -- ^Return value is a graphics object -createDirectionalLight colour (Vec3 x y z) = do - (cs, g3s, gui) <- ask +createDirectionalLight (Colour t r g b) (Vec3 x y z) = do + rs <- ask + let g3s = graphics3DSystem rs lightName <- getUniqueName "LO" light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_DIRECTIONAL liftIO $ Light.setPosition light x y z + liftIO $ Light.setDiffuseColour light r g b + liftIO $ Light.setSpecularColour light r g b let eo = Light light return eo
HGamer3D/APIs/Base/Graphics3D/Object3D.hs view
@@ -32,20 +32,26 @@ createColouredLineMesh, createColouredCubeMesh, createRainbowCubeMesh, + createNamedMesh, - createObject3D, + createObject3DFromMesh, createSphere, createCube, createPlane, createLine, - createNamedMeshObject, createColouredLine, createColouredCube, createRainbowCube, + loadMesh, + setObjectMaterial, - combineObjects + combineObjects, + + yaw3D, + roll3D, + pitch3D ) where @@ -121,9 +127,14 @@ NamedMesh String | -- Mesh resource loaded from file ManualMesh String -- Manual Mesh-Type, identified by name +createNamedMesh :: String -> MHGamer3D Mesh +createNamedMesh meshName = do + return (NamedMesh meshName) + createColouredLineMesh :: Vec3 -> Vec3 -> Material -> Colour -> MHGamer3D Mesh createColouredLineMesh vStart vEnd (NamedMaterial materialName) colour = do - (cs, g3s, gui) <- ask + rs <- ask + let g3s = graphics3DSystem rs lineName <- getUniqueName "Line" meshName <- getUniqueName "Mesh" mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) lineName @@ -142,7 +153,8 @@ createColouredCubeMesh (NamedMaterial materialName) colour = do - (cs, g3s, gui) <- ask + rs <- ask + let g3s = graphics3DSystem rs cubeName <- getUniqueName "Cube" meshName <- getUniqueName "Mesh" @@ -199,7 +211,8 @@ createRainbowCubeMesh :: MHGamer3D Mesh createRainbowCubeMesh = do - (cs, g3s, gui) <- ask + rs <- ask + let g3s = graphics3DSystem rs cubeName <- getUniqueName "Cube" meshName <- getUniqueName "Mesh" @@ -247,9 +260,10 @@ -createObject3D :: Mesh -> MHGamer3D Object3D -createObject3D mesh = do - (cs, g3s, gui) <- ask +createObject3DFromMesh :: Mesh -> MHGamer3D Object3D +createObject3DFromMesh mesh = do + rs <- ask + let g3s = graphics3DSystem rs -- first create entity from the mesh entity <- case mesh of CubeMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_CUBE @@ -268,43 +282,43 @@ createSphere :: MHGamer3D Object3D createSphere = do - ob <- createObject3D SphereMesh + ob <- createObject3DFromMesh SphereMesh return (ob) createCube :: MHGamer3D Object3D createCube = do - ob <- createObject3D CubeMesh + ob <- createObject3DFromMesh CubeMesh return (ob) createPlane :: MHGamer3D Object3D createPlane = do - ob <- createObject3D PlaneMesh + ob <- createObject3DFromMesh PlaneMesh return (ob) -createNamedMeshObject :: String -> MHGamer3D Object3D -createNamedMeshObject name = do - ob <- createObject3D (NamedMesh name) +loadMesh :: String -> MHGamer3D Object3D +loadMesh name = do + ob <- createObject3DFromMesh (NamedMesh name) return (ob) createLine :: Vec3 -> Vec3 -> Colour -> MHGamer3D Object3D createLine vStart vEnd colour = do mesh <- createColouredLineMesh vStart vEnd (NamedMaterial "BaseWhiteNoLighting") colour - ob <- createObject3D mesh + ob <- createObject3DFromMesh mesh return ob createColouredLine vStart vEnd material colour = do mesh <- createColouredLineMesh vStart vEnd material colour - ob <- createObject3D mesh + ob <- createObject3DFromMesh mesh return ob createColouredCube material colour = do mesh <- createColouredCubeMesh material colour - ob <- createObject3D mesh + ob <- createObject3DFromMesh mesh return ob createRainbowCube = do mesh <- createRainbowCubeMesh - ob <- createObject3D mesh + ob <- createObject3DFromMesh mesh return ob instance Position3D Object3D where @@ -353,7 +367,8 @@ -> MHGamer3D (Object3D) -- ^The return value is a new GraphicsObject combineObjects listObjects = do - (cs, g3s, gui) <- ask + rs <- ask + let g3s = graphics3DSystem rs 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) @@ -367,4 +382,27 @@ ) listObjects) return ( CombinedObject3D node listObjects) + +-- yaw, roll, pitch functions +-- functions, to rotate on axis, relative to object +rotRelativeToObjectAxis :: Object3D -> Vec3 -> Float -> MHGamer3D () +rotRelativeToObjectAxis object axis val = do + qob <- orientation3D object + let odir = actU qob axis + let qrot = rotU odir val + let nrot = qrot .*. qob + orientationTo3D object nrot + return () + +-- | rotate object on own axis (yaw) by angle +yaw3D :: Object3D -> Angle -> MHGamer3D () +yaw3D object val = rotRelativeToObjectAxis object (Vec3 0.0 1.0 0.0) (fromAngle val) + +-- | rotate object on own axis (roll) by angle +roll3D :: Object3D -> Angle -> MHGamer3D () +roll3D object val = rotRelativeToObjectAxis object (Vec3 0.0 0.0 1.0) (fromAngle val) + +-- | rotate object on own axis (pitch) by angle +pitch3D :: Object3D -> Angle -> MHGamer3D () +pitch3D object val = rotRelativeToObjectAxis object (Vec3 1.0 0.0 0.0) (fromAngle val)
HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs view
@@ -134,7 +134,8 @@ createIkosaederMesh :: String -> Colour -> MHGamer3D Mesh createIkosaederMesh material colour = do - (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs bodyName <- getUniqueName "Platon" meshName <- getUniqueName "Mesh" @@ -174,7 +175,8 @@ createDodekaederMesh :: String -> Colour -> MHGamer3D Mesh createDodekaederMesh material colour = do - (cs, g3s, gui) <- ask+ rs <- ask+ let g3s = graphics3DSystem rs bodyName <- getUniqueName "Platon" meshName <- getUniqueName "Mesh" @@ -234,12 +236,12 @@ createIkosaeder material colour = do mesh <- createIkosaederMesh material colour- ob <- createObject3D mesh+ ob <- createObject3DFromMesh mesh return ob createDodekaeder material colour = do mesh <- createDodekaederMesh material colour- ob <- createObject3D mesh+ ob <- createObject3DFromMesh mesh return ob
+ HGamer3D/APIs/Base/Network/EngineHelper.hs view
@@ -0,0 +1,53 @@+-- 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++-- |Network API, Network Module, EngineHelper Sub-Module.+++module HGamer3D.APIs.Base.Network.EngineHelper++(+ initNetworkEngine+)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector++import HGamer3D.Bindings.Enet.ClassPtr+import HGamer3D.Bindings.Enet.Utils++import HGamer3D.Bindings.Enet.ClassEnet as Enet++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader++++initNetworkEngine :: IO (NetworkSystem)+initNetworkEngine = do+ let enet = HG3DClass nullPtr nullPtr+ let ns = (NetworkSystem enet)+ return ns
+ HGamer3D/APIs/Base/Network/Network.hs view
@@ -0,0 +1,143 @@+-- 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.++-- Network.hs++-- |Base API, Network Module.+++module HGamer3D.APIs.Base.Network.Network++(+ NetworkClient (..),+ NetworkServer (..),+ NetworkPacket (..),+ createNetworkClient,+ createNetworkServer,+ connectClientToServer,+ disconnectClient,+ NetworkNode (..)+)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector++import Foreign.Ptr+import HGamer3D.Bindings.Enet.ClassEnet as Enet+import HGamer3D.Bindings.Enet.ClassEnetServer as EnetServer+import HGamer3D.Bindings.Enet.ClassEnetClient as EnetClient+import HGamer3D.Bindings.Enet.ClassEnetPacket as EnetPacket+import HGamer3D.Data.HG3DClass++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader++data NetworkClient = NetworkClient HG3DClass+data NetworkServer = NetworkServer HG3DClass+data NetworkPacket = NetworkPacket {+ clientname :: String,+ channel :: Int,+ message :: String + }++createNetworkClient :: MHGamer3D NetworkClient+createNetworkClient = do+ client <- liftIO $ Enet.createClient+ return (NetworkClient client)+ +createNetworkServer :: Int -> MHGamer3D NetworkServer+createNetworkServer port = do+ server <- liftIO $ Enet.createServer port+ return (NetworkServer server)++connectClientToServer :: NetworkClient -> String -> Int -> MHGamer3D Bool+connectClientToServer (NetworkClient client) serveraddress port = do+ ok <- liftIO $ EnetClient.connect client serveraddress port+ return ok+ +disconnectClient :: NetworkClient -> MHGamer3D Bool+disconnectClient (NetworkClient client) = do+ ok <- liftIO $ EnetClient.disconnect client+ return ok++class NetworkNode a where+ sendNetworkMessage :: a -> String -> Int -> String -> MHGamer3D ()+ receiveNetworkMessages :: a -> TimeMS -> MHGamer3D [NetworkPacket]+++_transformPackage :: HG3DClass -> MHGamer3D NetworkPacket+_transformPackage p = do+ message <- liftIO $ EnetPacket.getData p+ channel <- liftIO $ EnetPacket.getChannel p+ clientname <- liftIO $ EnetPacket.getPeer p+ liftIO $ EnetPacket.delete p+ return $ NetworkPacket clientname channel message++_receiveClient client ms pkg = do+ liftIO $ EnetClient.serve client ms+ p <- liftIO $ EnetClient.getPacket client+ let (HG3DClass aptr bptr) = p+ if aptr /= nullPtr + then do+ p' <- _transformPackage p+ pkg' <- _receiveClient client ms (pkg ++ [p'])+ return pkg'+ else do+ return pkg + +_receiveServer server ms pkg = do+ liftIO $ EnetServer.serve server ms+ p <- liftIO $ EnetServer.getPacket server+ let (HG3DClass aptr bptr) = p+ if aptr /= nullPtr + then do+ p' <- _transformPackage p+ pkg' <- _receiveServer server ms (pkg ++ [p'])+ return pkg'+ else do+ return pkg + +instance NetworkNode NetworkClient where+ + sendNetworkMessage (NetworkClient client) clientname channel message = do+ liftIO $ EnetClient.send client message channel+ return ()++ receiveNetworkMessages (NetworkClient client) (TimeMS ms) = do+ allPs <- _receiveClient client ms []+ return allPs++instance NetworkNode NetworkServer where++ sendNetworkMessage (NetworkServer server) clientname channel message = do+ liftIO $ EnetServer.send server clientname message channel+ return ()++ receiveNetworkMessages (NetworkServer server) (TimeMS ms) = do+ allPs <- _receiveServer server ms []+ return allPs+++ +
+ HGamer3D/APIs/Base/Physics/EngineHelper.hs view
@@ -0,0 +1,59 @@+-- 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++-- |Physics API, Physics Module, EngineHelper Sub-Module.+++module HGamer3D.APIs.Base.Physics.EngineHelper++(+ initPhysicsEngine+)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector++import HGamer3D.Bindings.Bullet.ClassHG3DBulletMotionStateHandler as Motion+import HGamer3D.Bindings.Bullet.ClassHG3DBulletDefaultCreator as Bullet+import HGamer3D.Bindings.Bullet.ClassConeShapeX as Cone+import HGamer3D.Bindings.Bullet.ClassDynamicsWorld as World+import HGamer3D.Bindings.Bullet.ClassHG3DRigidBodyCreator as Rigids++import HGamer3D.Bindings.Bullet.ClassPtr+import HGamer3D.Bindings.Bullet.Utils++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader++++initPhysicsEngine :: IO PhysicsSystem+initPhysicsEngine = do++ bullet <- Bullet.new+ world <- Bullet.getDynamicsWorld bullet+ let ps = (PhysicsSystem bullet world)+ return ps
+ HGamer3D/APIs/Base/Physics/Physics.hs view
@@ -0,0 +1,181 @@+-- 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.++-- Physics.hs++-- |Base API, Physics Module.+++module HGamer3D.APIs.Base.Physics.Physics++(+ Body (..),+ createSphereBody,+ createBoxBody,+ createCylinderBody,+ createCapsuleBody,+ createConeBody,+ createStaticPlaneBody,+ + physicsSimulationStep,+ setBodyGravity,+ getBodyGravity,+ applyBodyImpulse,+ getBodyLinearVelocity,+ setBodyLinearVelocity+)++where++import GHC.Ptr++import HGamer3D.Data.HG3DClass+import HGamer3D.Data.Vector+import HGamer3D.APIs.Base.Graphics3D.Basic3D++import HGamer3D.Bindings.Bullet.ClassHG3DBulletMotionStateHandler as Motion+import HGamer3D.Bindings.Bullet.ClassHG3DBulletDefaultCreator as Bullet+import HGamer3D.Bindings.Bullet.ClassConeShapeX as Cone+import HGamer3D.Bindings.Bullet.ClassDynamicsWorld as World+import HGamer3D.Bindings.Bullet.ClassHG3DRigidBodyCreator as Rigids+import HGamer3D.Bindings.Bullet.ClassRigidBody as RBody++import HGamer3D.Bindings.Bullet.ClassPtr+import HGamer3D.Bindings.Bullet.Utils++-- here the physics includes+++import HGamer3D.APIs.Base.Engine.Types++import Control.Monad.Trans+import Control.Monad.Reader++data Body = Body HG3DClass+++createSphereBody :: Float -> Vec3 -> Quaternion -> Float -> MHGamer3D Body+createSphereBody mass position quat radius = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ sphere <- liftIO $ Rigids.createSphere mass position quat radius+ liftIO $ World.addRigidBody world sphere+ return (Body sphere)++createBoxBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body+createBoxBody mass position quat halfExtends = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ box <- liftIO $ Rigids.createBox mass position quat halfExtends+ liftIO $ World.addRigidBody world box+ return (Body box)++createCylinderBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body+createCylinderBody mass position quat halfExtends = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ cylinder <- liftIO $ Rigids.createCylinder mass position quat halfExtends+ liftIO $ World.addRigidBody world cylinder+ return (Body cylinder)++createCapsuleBody :: Float -> Vec3 -> Quaternion -> Float -> Float -> MHGamer3D Body+createCapsuleBody mass position quat radius height = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ capsule <- liftIO $ Rigids.createCapsule mass position quat radius height+ liftIO $ World.addRigidBody world capsule+ return (Body capsule)++createConeBody :: Float -> Vec3 -> Quaternion -> Float -> Float -> MHGamer3D Body+createConeBody mass position quat radius height = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ cone <- liftIO $ Rigids.createCone mass position quat radius height+ liftIO $ World.addRigidBody world cone+ return (Body cone)++createStaticPlaneBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body+createStaticPlaneBody mass position quat origin = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ plane <- liftIO $ Rigids.createStaticPlane mass position quat origin+ liftIO $ World.addRigidBody world plane+ return (Body plane)++physicsSimulationStep :: Float -> Int -> Float -> MHGamer3D Int+physicsSimulationStep timeStep maxSubSteps fixedTimeStep = do+ rs <- ask+ let ps = physicsSystem rs+ let phys = psPhysics ps+ let world = psWorld ps+ val <- liftIO $ World.stepSimulation world timeStep maxSubSteps fixedTimeStep+ return val++instance Position3D Body where++ position3D (Body body) = do+ pos <- liftIO $ Motion.getPosition body+ return pos+ positionTo3D (Body body) pos = do+ liftIO $ Motion.setPosition body pos++instance Orientation3D Body where++ orientation3D (Body body) = do+ dir <- liftIO $ Motion.getQuaternion body+ return ((toU . mkNormal . fromQ) dir)+ orientationTo3D (Body body) dir = do+ liftIO $ Motion.setQuaternion body ((toQ . fromU) dir)+ +setBodyGravity :: Body -> Vec3 -> MHGamer3D ()+setBodyGravity (Body body) grav = do+ liftIO $ RBody.setGravity body grav+ return ()++getBodyGravity :: Body -> MHGamer3D Vec3+getBodyGravity (Body body) = do+ grav <- liftIO $ RBody.getGravity body+ return grav+ +applyBodyImpulse :: Body -> Vec3 -> Vec3 -> MHGamer3D ()+applyBodyImpulse (Body body) imp relpos = do+ liftIO $ RBody.applyImpulse body imp relpos+ +getBodyLinearVelocity :: Body -> MHGamer3D Vec3+getBodyLinearVelocity (Body body) = do+ vel <- liftIO $ RBody.getLinearVelocity body+ return vel+ +setBodyLinearVelocity :: Body -> Vec3 -> MHGamer3D ()+setBodyLinearVelocity (Body body) vel = do+ liftIO $ RBody.setLinearVelocity body vel+ return ()+ +
HGamer3D/BaseAPI.hs view
@@ -36,7 +36,10 @@ module HGamer3D.APIs.Base.Graphics3D.Object3D, module HGamer3D.APIs.Base.Graphics3D.PlatonObjects, - module HGamer3D.APIs.Base.GUI.BasicGUI+ module HGamer3D.APIs.Base.GUI.BasicGUI,+ module HGamer3D.APIs.Base.Physics.Physics,+ module HGamer3D.APIs.Base.Network.Network+ ) where@@ -58,6 +61,8 @@ import qualified Data.Map as Map import HGamer3D.APIs.Base.GUI.BasicGUI+import HGamer3D.APIs.Base.Physics.Physics+import HGamer3D.APIs.Base.Network.Network import Control.Monad.Trans (liftIO)