HGamer3D 0.2.0 → 0.2.1
raw patch · 25 files changed
+1277/−346 lines, 25 filesdep +monad-loopsdep +netwiredep +splitdep ~HGamer3D-Bullet-Bindingdep ~HGamer3D-CEGUI-Bindingdep ~HGamer3D-Ogre-Binding
Dependencies added: monad-loops, netwire, split
Dependency ranges changed: HGamer3D-Bullet-Binding, HGamer3D-CEGUI-Binding, HGamer3D-Ogre-Binding, directory
Files
- HGamer3D.cabal +3/−3
- HGamer3D/APIs/Base.hs +70/−0
- HGamer3D/APIs/Base/Audio/Audio.hs +25/−28
- HGamer3D/APIs/Base/Engine/Engine.hs +123/−60
- HGamer3D/APIs/Base/Engine/Types.hs +36/−20
- HGamer3D/APIs/Base/GUI/BasicGUI.hs +139/−43
- HGamer3D/APIs/Base/GUI/EngineHelper.hs +12/−10
- HGamer3D/APIs/Base/Graphics3D/Basic3D.hs +43/−8
- HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs +8/−9
- HGamer3D/APIs/Base/Graphics3D/Light.hs +18/−15
- HGamer3D/APIs/Base/Graphics3D/Object3D.hs +64/−31
- HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs +17/−8
- HGamer3D/APIs/Base/InputSystem/InputSystem.hs +34/−20
- HGamer3D/APIs/Base/Network/EngineHelper.hs +3/−5
- HGamer3D/APIs/Base/Network/Network.hs +53/−13
- HGamer3D/APIs/Base/Physics/EngineHelper.hs +2/−2
- HGamer3D/APIs/Base/Physics/Physics.hs +2/−2
- HGamer3D/APIs/FRP.hs +46/−0
- HGamer3D/APIs/FRP/GUI.hs +283/−0
- HGamer3D/APIs/FRP/Graphics3D.hs +97/−0
- HGamer3D/APIs/FRP/InputSystem.hs +123/−0
- HGamer3D/APIs/FRP/Network.hs +25/−0
- HGamer3D/APIs/FRP/Types.hs +48/−0
- HGamer3D/BaseAPI.hs +0/−68
- LICENSE +3/−1
HGamer3D.cabal view
@@ -1,5 +1,5 @@ Name: HGamer3D -Version: 0.2.0 +Version: 0.2.1 Synopsis: Windows Game Engine for the Haskell Programmer Description: HGamer3D is a game engine for developing 3D games in the programming @@ -19,9 +19,9 @@ Extra-source-files: Setup.hs Library - 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 + Build-Depends: base >= 3 && < 5, containers, text, directory == 1.1.0.2, Win32, mtl, FindBin, monad-loops, split, netwire == 4.0.7, HGamer3D-Data >= 0.2.0, HGamer3D-Ogre-Binding == 0.2.1, HGamer3D-SFML-Binding == 0.2.0, HGamer3D-CEGUI-Binding == 0.2.1, HGamer3D-Bullet-Binding == 0.2.1, 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,HGamer3D.APIs.Base.Network.EngineHelper,HGamer3D.APIs.Base.Network.Network,HGamer3D.APIs.Base.Physics.EngineHelper,HGamer3D.APIs.Base.Physics.Physics + 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.APIs.Base,HGamer3D.APIs.Base.Network.EngineHelper,HGamer3D.APIs.Base.Network.Network,HGamer3D.APIs.Base.Physics.EngineHelper,HGamer3D.APIs.Base.Physics.Physics, HGamer3D.APIs.FRP.GUI, HGamer3D.APIs.FRP.Graphics3D,HGamer3D.APIs.FRP.InputSystem,HGamer3D.APIs.FRP.Network,HGamer3D.APIs.FRP.Types,HGamer3D.APIs.FRP Other-modules: c-sources:
+ HGamer3D/APIs/Base.hs view
@@ -0,0 +1,70 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2011 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- BaseAPI.hs++-- |HGamer3D Base API: basic Haskell API for HGamer3D, based on the low-level bindings, with moderate abstraction on top of it.++module HGamer3D.APIs.Base++(+ -- * Data definitions, re-exported+ module HGamer3D.Data.Colour,+ module HGamer3D.Data.Vector,+ module HGamer3D.Data.Angle,++ -- * Main API functionality, split into sub modules+ module HGamer3D.APIs.Base.Audio.Audio,+ module HGamer3D.APIs.Base.InputSystem.InputSystem,+ module HGamer3D.APIs.Base.Graphics3D.Basic3D,+ module HGamer3D.APIs.Base.Graphics3D.Light,+ module HGamer3D.APIs.Base.Graphics3D.Object3D,+ module HGamer3D.APIs.Base.Graphics3D.PlatonObjects,+ module HGamer3D.APIs.Base.GUI.BasicGUI,+ module HGamer3D.APIs.Base.Physics.Physics,+ module HGamer3D.APIs.Base.Network.Network,+ + -- * Game-Loop and internal functionality+ module HGamer3D.APIs.Base.Engine.Types,+ module HGamer3D.APIs.Base.Engine.Engine+)++where++import HGamer3D.Data.Colour+import HGamer3D.Data.Vector+import HGamer3D.Data.Angle++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 HGamer3D.APIs.Base.Physics.Physics+import HGamer3D.APIs.Base.Network.Network++import Control.Monad.Trans (liftIO)+
HGamer3D/APIs/Base/Audio/Audio.hs view
@@ -18,42 +18,36 @@ -- Audio.hs --- |Base API, Audio Module, Audio Sub-Module.--- Basic Audio functionality of the HGamer3D engine.+-- |The Audio functionality of the Base API. module HGamer3D.APIs.Base.Audio.Audio (- -- Enums- --+ -- * Types module HGamer3D.Bindings.SFML.EnumSoundSourceStatus,- - - -- Data- -- AudioSource (..), - -- Listener Functions+ -- * Listener Functions setAudioMainVolume, getAudioMainVolume, setAudioListenerPosition, setAudioListenerDirection,- - -- Source creation and delete Functions+ -- * Source creation and delete Functions createMusic, createSound, deleteAudioSource, - -- Source play function+ -- * Source play function playAudioSource, pauseAudioSource, stopAudioSource,++ -- * Source property functions setAudioSourceLoop, getAudioSourceLoop, - -- Source Functions getAudioSourceVolume, setAudioSourceVolume, @@ -104,30 +98,31 @@ -- Listener Functions -- | set overall main audio volume-setAudioMainVolume :: Float -- ^volume in a scale between 0 and 100.0+setAudioMainVolume :: Float -- ^ volume in a scale between 0 and 100.0 -> MHGamer3D () setAudioMainVolume vol = liftIO $ Listener.setGlobalVolume vol -- | get overall main audio volume-getAudioMainVolume :: MHGamer3D Float+getAudioMainVolume :: MHGamer3D Float -- ^ volume in a scale between 0 and 100.0 getAudioMainVolume = liftIO $ Listener.getGlobalVolume --- | set position of the listener, this is where the "micro" is located-setAudioListenerPosition :: Vec3 -- ^position of listener+-- | 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 ()+-- | set direction of the listener+setAudioListenerDirection :: Vec3 -- ^ direction, in which listener hears+ -> MHGamer3D () setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z -- Music Functions, deletion and cretion of Audio types -- --- | create music with filename, music is buffered stream-createMusic :: String -- ^filename of music without path- -> MHGamer3D (Maybe AudioSource) -- ^audio source, which can be played+-- | create music (stream source, reading from file)+createMusic :: String -- ^ filename of music without path+ -> MHGamer3D (Maybe AudioSource) -- ^ audio source, which can be played createMusic filename = do music <- liftIO $ Music.new rs <- ask@@ -146,9 +141,9 @@ liftIO $ Music.delete music return Nothing --- | 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+-- | create sound (stream source, loaded 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@@ -170,6 +165,7 @@ liftIO $ SoundBuffer.delete buffer return Nothing +-- | delete audio source deleteAudioSource :: AudioSource -> MHGamer3D () deleteAudioSource (Music music) = do liftIO $ Music.delete music@@ -181,7 +177,7 @@ -- Source play, pause, stop -- --- | starts playing audio, which can be music or sound+-- | starts playing audio source playAudioSource :: AudioSource -- ^the audio source -> MHGamer3D () playAudioSource (Music music) = do@@ -189,7 +185,7 @@ playAudioSource (Sound sound buffer) = do liftIO $ Sound.play sound --- | pause playing audio, remembers location+-- | pause playing audio source, remembers location pauseAudioSource :: AudioSource -> MHGamer3D () pauseAudioSource (Music music) = do liftIO $ SoundStream.pause music@@ -240,7 +236,8 @@ setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v --- | get audio source pitch, the pitch is the frequency of the sound which also influences playing speed. The default value is 1.0.+-- | 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
HGamer3D/APIs/Base/Engine/Engine.hs view
@@ -18,22 +18,25 @@ -- Engine.hs --- |Base API, Engine Module, Engine Sub-Module.--- Basic functionality of the HGamer3D engine.-+-- | Game-Loop and internals of Base API implementation module HGamer3D.APIs.Base.Engine.Engine ( + -- * utility functions getUniqueName, mapFunctionToTag, getFunctionFromTag,- initCommonSystem,- getTimeMS,+ + -- * basic functions, to constitute running system+-- initCommonSystem, runMHGamer3D, initHGamer3D,- createEventMap, renderLoop+ + -- * usage of game loop+ -- $intro + ) where@@ -67,6 +70,7 @@ import Control.Monad.Reader import Control.Monad.State import Control.Concurrent+import Data.List import System.Win32.Process import qualified Data.Text as T@@ -75,42 +79,68 @@ import qualified Data.Map as Map import System.Win32.Time import System.Environment.FindBin+import System.Win32.Registry +import Data.List.Split --- identification dll----hg3ddllname :: String-hg3ddllname = "HGamer3D-Version-0.2.0-DontDelete.txt" --- unique identifiers, by appending a unique integer to a prefix-+-- | get 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)+ enstate <- lift get+ let HG3DEngineState (x:xs) evtmap = enstate+ lift $ put (HG3DEngineState xs evtmap) return (prefix ++ (show x)) --- event function mapping+-- |event function mapping, map a function to a tag (a string identifier)+mapFunctionToTag :: String -> EventFunction -> MHGamer3D ()+mapFunctionToTag tag function = do+ enstate <- lift get+ let HG3DEngineState un evtmap = enstate+ let evtmap2 = Map.insert tag function evtmap+ lift $ put (HG3DEngineState un evtmap2)+ return () -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+-- |event function mapping, return the function of the tag (string identifier)+getFunctionFromTag :: String -> MHGamer3D (Maybe EventFunction)+getFunctionFromTag tag = do+ enstate <- lift get+ let eventMap = esEventMap enstate+ let fr = Map.lookup tag eventMap+ return fr -- function, which finds installation path of HG3D -- +-- assumes very strict versioning info in version.cfg, 3rd line will have version without dots!+-- version.cfg will be located in "media/engine"++readVersion path = do + text <- readFile (path ++ "/media/engine/version.cfg")+ let ver = (splitOn "=" ((splitOn "\n" text)!!2))!!1+ return ver+ ++-- function, which ignores all behind a specific string+ignoreTextAfterIndicator :: String -> String -> String+ignoreTextAfterIndicator text indicator = case text of + [] -> []+ (x:xs) -> if (indicator `Data.List.isPrefixOf` text) then [] else (x : (ignoreTextAfterIndicator xs indicator))+ 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)+ progpath2 <- getProgPath+ -- fix error of getProgPath in ghci, cut of line at "\-l..."+ let progpath = ignoreTextAfterIndicator progpath2 "\\-l"+ -- read version file+ v <- readVersion progpath+ key <- regCreateKey hKEY_LOCAL_MACHINE ("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\hg3dpath" ++ v ++ ".exe")+ binpath <- regQueryValue key (Just "Path")+ -- remove "/bin" from path+ let path = take (length binpath - 4) binpath+ return (path, progpath) +-- | internal function, to initialize common system record, not used by end-users initCommonSystem :: IO CommonSystem initCommonSystem = do (csHG3DPath, csProgPath) <- getHG3DPath@@ -118,15 +148,17 @@ -- Milliseconds Timescale -+-- | get current game time in milliseconds getTimeMS :: MHGamer3D (TimeMS) getTimeMS = do fr <- liftIO $ queryPerformanceFrequency wt <- liftIO $ queryPerformanceCounter return (TimeMS $ fromIntegral (wt * 1000 `div` fr)) --runMHGamer3D :: (HG3DReaderState, HG3DEngineState) -> MHGamer3D a -> IO (a, (HG3DReaderState, HG3DEngineState))+-- | run a HGamer3D monad function within the states of the game+runMHGamer3D :: (HG3DReaderState, HG3DEngineState) -- ^ initial state, taken from initMHGamer3D + -> MHGamer3D a -- ^ the action, which should be run in the monad+ -> IO (a, (HG3DReaderState, HG3DEngineState)) -- ^ the output value and updated state of the monad runMHGamer3D (readerstate, enginestate) action = do (actionResult, newEnginestate) <- runStateT (runReaderT action readerstate ) enginestate return (actionResult, (readerstate, newEnginestate))@@ -145,8 +177,9 @@ let ms = if leftButton then MouseUp else MouseDown return (TimeMouseState ms tms) --initHGamer3D :: String -> IO (HG3DReaderState, HG3DEngineState)+-- | initialize the HGamer3D system+initHGamer3D :: String -- ^ name of the window (shown in main title bar)+ -> IO (HG3DReaderState, HG3DEngineState) -- ^ the state value needed for further invocation of HGamer3D code through the monad. initHGamer3D windowName = do -- init Commons configs@@ -171,8 +204,8 @@ -- init Phyiscs engine physics <- initPhysicsEngine - - let enginestate = HG3DEngineState [1..]+ let eventmap = Map.fromList ([]::[(String, EventFunction)])+ let enginestate = HG3DEngineState [1..] eventmap let readerstate = HG3DReaderState cs g3s gui network physics return (readerstate, enginestate)@@ -241,51 +274,81 @@ 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+renderInternalLoop :: Int -> TimeMouseState -> gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D ()+renderInternalLoop frameRate rsold gamestate renderStep = do let (TimeMouseState ms (TimeMS timeold)) = rsold- gsnew <- getEventsFromGui gamestate eventMap+ getEventsFromGui (flagStep, rs) <- renderInternalStep frameRate rsold let (TimeMouseState ms (TimeMS time)) = rs let delta = (TimeMS (time - timeold))- (flagLoop, gsnew2) <- renderStep delta gsnew+ (flagLoop, gsnew) <- renderStep delta gamestate if (flagStep && flagLoop) then do- renderInternalLoop frameRate rs gsnew2 eventMap renderStep+ renderInternalLoop frameRate rs gsnew renderStep else return () - -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-+-- | the main loop, call this at end of your world preparation, to start game loop+renderLoop :: Int -- ^ the frame rate, you want to achieve, frames per second+ -> worldState -- ^ a type of your choice for the world state+ -> (TimeMS -> worldState -> MHGamer3D (Bool, worldState)) -- ^ the renderStep function, a function which gets called each step, the bool value indicates if world should run further (True) or if world should stop (False).+ -> MHGamer3D ()+renderLoop frameRate gamestate renderStep = do rs <- initTimeMouseState- renderInternalLoop frameRate rs gamestate eventMap renderStep+ renderInternalLoop frameRate rs gamestate renderStep -- event loop -getEventsFromGui :: a -> EventMap a -> MHGamer3D a-getEventsFromGui a eventMap = do+getEventsFromGui :: MHGamer3D ()+getEventsFromGui = do 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+ if processEvents then do (name, sender, window) <- liftIO $ HG3DEventController.popEvent eventController let evt = GUIEvent name sender window- let evtfunc = getFunctionFromTag name eventMap- innera <- case evtfunc of+ evtfunc <- getFunctionFromTag name + case evtfunc of Just func -> do- fa <- func evt a- return fa- Nothing -> return a- loopa <- getEventsFromGui innera eventMap- return loopa+ func evt+ return ()+ Nothing -> return ()+ getEventsFromGui + return () else do- return a- return outera+ return ()+ return ()++{-$intro+use as in the following code example:+first define a renderStep function++@+ renderStep :: TimeMS -> Gameworld -> MHGamer3D (Bool, Gameworld)+ renderStep (TimeMS time) cube = do+ yaw3D cube (Rad 0.005) + roll3D cube (Rad 0.002)+ return (True, cube)+@ ++in the main program, initialize your objects, and at the end call the game loop++@+ main3DProgram = do+ \-- do some more init here: lights, objects, ...+ renderLoop 40 cubeBlue renderStep+ return ()+@++in the main program, just run the main init routine and the main program in the HGamer3D monad++@+ main = do+ hg <- initHGamer3D \"HGamer3D - Getting Started Example\" + (l, hg) <- runMHGamer3D hg main3DProgram + return ()+@++-}
HGamer3D/APIs/Base/Engine/Types.hs view
@@ -18,26 +18,28 @@ -- Types.hs --- |Base API, Engine Module, Types Sub-Module.--- Basic types of the HGamer3D engine.-+-- |Types of the Base API. module HGamer3D.APIs.Base.Engine.Types ( - MHGamer3D,- Event (..),- EventFunction,- EventMap,- + -- * records for sub system objects from low-level API CommonSystem (..), Graphics3DSystem (..), GUISystem (..), NetworkSystem (..), PhysicsSystem (..), + -- * the main HGamer3D monad HG3DReaderState (..), HG3DEngineState (..),- + MHGamer3D,+ + -- * Events+ Event (..),+ EventFunction,+ EventMap,+ + -- * Time TimeMS (..), ) @@ -48,14 +50,15 @@ import Control.Monad.State import qualified Data.Map as Map -+-- | General information, needed in all sub-systems data CommonSystem = CommonSystem {- csHG3DPath::String,- csProgPath::String+ csHG3DPath::String, -- ^ the path, where the binaries of HGamer3D are installed (install directory, without bin)+ csProgPath::String -- ^ the path, from which the final linked executable has been started }- ++-- | 3D Graphics objects (Ogre specific) data Graphics3DSystem = Graphics3DSystem {- g3sRoot::HG3DClass,+ g3sRoot::HG3DClass, g3sSceneManager::HG3DClass, g3sResourceGroupManager::HG3DClass, g3sTextureManager::HG3DClass,@@ -67,6 +70,7 @@ g3sMessagePump::HG3DClass } +-- | GUI System objects (CEGUI specific) data GUISystem = GUISystem { guiRenderer::HG3DClass, guiGUI::HG3DClass,@@ -77,15 +81,18 @@ guiEventController::HG3DClass } +-- | Network System objects data NetworkSystem = NetworkSystem { nsNetwork::HG3DClass } +-- | Physics System objects data PhysicsSystem = PhysicsSystem { psPhysics::HG3DClass, psWorld::HG3DClass } +-- | Data, which can be read by all sub-system implementations, but not modified data HG3DReaderState = HG3DReaderState { commonSystem::CommonSystem, graphics3DSystem::Graphics3DSystem,@@ -94,17 +101,26 @@ 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, which can be read and modified (for State monad) data HG3DEngineState = HG3DEngineState {- esUniqueNumbers::[Integer]+ esUniqueNumbers::[Integer],+ esEventMap::EventMap } +-- | the HGamer3D monad, a monad stack of reader and state monad type MHGamer3D a = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) a +-- | summary data type for all types of Events+data Event = + GUIEvent String String HG3DClass -- ^ GUI Event: name sender window++-- | an event function is reacting on an event with a side effect only+type EventFunction = Event -> MHGamer3D ()++-- | map of all events+type EventMap = Map.Map String EventFunction++-- | the time type of HGamer3D (in milliseconds) data TimeMS = TimeMS Int -- time in milliseconds instance Show TimeMS where
HGamer3D/APIs/Base/GUI/BasicGUI.hs view
@@ -18,19 +18,31 @@ -- BasicGUI.hs --- |Base API, GUI Module, BasicGUI Sub-Module.--- Basic GUI functionality.-+-- |GUI functionality of the Base API. module HGamer3D.APIs.Base.GUI.BasicGUI (+ -- * Types GUIElement (..), + -- * Initialization and configuration functions loadGuiLayoutFromFile,- addGuiElToDisplay,+ loadGuiScheme,+ loadGuiFont,+ setGuiDefaultFont,+ setGuiDefaultMouseCursor,+ setGuiDefaultTooltip,+ + -- * Find and display GUI Elements+ getChildGuiEl,+ findChildGuiElRecursive,+ addGuiElToDisplay, removeGuiElFromDisplay, + -- * Set specific GUI Element properties+ getGuiElProperty,+ setGuiElProperty, enableGuiEl, disableGuiEl, activateGuiEl,@@ -38,23 +50,15 @@ showGuiEl, hideGuiEl, - getChildGuiEl,- findChildGuiElRecursive,- getGuiElProperty,- setGuiElProperty,- - loadGuiScheme,- loadGuiFont,- setGuiDefaultFont,- setGuiDefaultMouseCursor,- setGuiDefaultTooltip,- + -- * Listbox, Compobox specific functions listboxAddText,+ listboxGetSelectedText,+ listboxRemoveAllText, comboboxAddText,+ comboboxRemoveAllText, + -- * GUI Event handling mapGuiElEventToFunction,- - ) where@@ -76,15 +80,23 @@ import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF import HGamer3D.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF+import HGamer3D.Bindings.CEGUI.ClassListbox as Listbox+import HGamer3D.Bindings.CEGUI.ClassListboxItem as ListboxItem+import HGamer3D.Bindings.CEGUI.ClassCombobox as Combobox import HGamer3D.Data.HG3DClass import Control.Monad.Trans import Control.Monad.Reader+import Control.Monad.Loops import HGamer3D.Data.Vector -data GUIElement = GUIElement HG3DClass+-- | The GUI Element, a window, a button, any widget or widget element, organized in a hierarchy+data GUIElement = GUIElement HG3DClass -- ^ only one constructor, currently GUI elements are not specified in more detail -loadGuiLayoutFromFile :: String -> String -> MHGamer3D GUIElement+-- | load a complete layout file into the application+loadGuiLayoutFromFile :: String -- ^ filename, without the path (this is defined by resource locations)+ -> String -- ^ prefix to append to the identifiers in the layout, this allows, to load the same dailog/gui element multiple times with different names, if needed+ -> MHGamer3D GUIElement -- ^ the resulting tree of GUI elements as top GUI element loadGuiLayoutFromFile layoutFile prefix = do rs <- ask let gui = guiSystem rs@@ -92,7 +104,9 @@ window <- liftIO $ WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix return (GUIElement window) -addGuiElToDisplay :: GUIElement -> MHGamer3D ()+-- | add a GUI element to the display+addGuiElToDisplay :: GUIElement -- ^ GUI element+ -> MHGamer3D () addGuiElToDisplay (GUIElement window) = do rs <- ask let gui = guiSystem rs@@ -100,7 +114,9 @@ guiSheet <- liftIO $ System.getGUISheet guiS liftIO $ Window.addChildWindow2 guiSheet window -removeGuiElFromDisplay :: GUIElement -> MHGamer3D ()+-- | remove a GUI element from the display+removeGuiElFromDisplay :: GUIElement -- ^ GUI element+ -> MHGamer3D () removeGuiElFromDisplay (GUIElement window) = do rs <- ask let gui = guiSystem rs@@ -108,100 +124,180 @@ guiSheet <- liftIO $ System.getGUISheet guiS liftIO $ Window.removeChildWindow2 guiSheet window -enableGuiEl :: GUIElement -> MHGamer3D ()+-- | enable GUI element, allow interaction with it and render it accordingly+enableGuiEl :: GUIElement -- ^ GUI element to enable+ -> MHGamer3D () enableGuiEl (GUIElement window) = do liftIO $ Window.enable window -disableGuiEl :: GUIElement -> MHGamer3D ()+-- | disable GUI element, disallow interaction with it and render it accordingly+disableGuiEl :: GUIElement -- ^ GUI element to disable+ -> MHGamer3D () disableGuiEl (GUIElement window) = do liftIO $ Window.disable window -activateGuiEl :: GUIElement -> MHGamer3D ()+-- | activate GUI element, process events send to it+activateGuiEl :: GUIElement -- ^ GUI element to activate+ -> MHGamer3D () activateGuiEl (GUIElement window) = do liftIO $ Window.activate window -deactivateGuiEl :: GUIElement -> MHGamer3D ()+-- | deactivate GUI element, do not process events send to it+deactivateGuiEl :: GUIElement -- ^ GUI element to deactivate+ -> MHGamer3D () deactivateGuiEl (GUIElement window) = do liftIO $ Window.deactivate window -showGuiEl :: GUIElement -> MHGamer3D ()+-- | show GUI element+showGuiEl :: GUIElement -- ^ GUI element to show+ -> MHGamer3D () showGuiEl (GUIElement window) = do liftIO $ Window.show window -hideGuiEl :: GUIElement -> MHGamer3D ()+-- | hide GUI element+hideGuiEl :: GUIElement -- ^ GUI element to hide+ -> MHGamer3D () hideGuiEl (GUIElement window) = do liftIO $ Window.hide window -getChildGuiEl :: GUIElement -> String -> MHGamer3D GUIElement+-- | get child gui element, throws an exception, if element not found in children, only searches the direct children of element.+getChildGuiEl :: GUIElement -- ^ GUI element, which childrens are searched for child element+ -> String -- ^ name of searched child element+ -> MHGamer3D GUIElement -- ^ found element (throws exception, in case no child found) getChildGuiEl (GUIElement window) name = do window <- liftIO $ Window.getChild window name return (GUIElement window) -findChildGuiElRecursive :: GUIElement -> String -> MHGamer3D (Maybe GUIElement)+-- | find child element recursively, searches all sub-trees+findChildGuiElRecursive :: GUIElement -- ^ GUI element, which childrens are searched, including children of children and so on.+ -> String -- ^ name of child element to be found+ -> MHGamer3D (Maybe GUIElement) -- ^ in case of found element: Just el, Nothing otherwhise findChildGuiElRecursive (GUIElement window) name = do window <- liftIO $ Window.getChildRecursive window name if (ocPtr window) == nullPtr then do return Nothing else do return (Just (GUIElement window))- -getGuiElProperty :: GUIElement -> String -> MHGamer3D String++-- | get a named property as string from element+getGuiElProperty :: GUIElement -- ^ GUI element+ -> String -- ^ property name to get+ -> MHGamer3D String -- ^ property value getGuiElProperty (GUIElement window) name = do prop <- liftIO $ PropertySet.getProperty window name return prop -setGuiElProperty :: GUIElement -> String -> String -> MHGamer3D ()+-- | set a named property +setGuiElProperty :: GUIElement -- ^ GUI element+ -> String -- ^ property name to set+ -> String -- ^ property value as string+ -> MHGamer3D () setGuiElProperty (GUIElement window) name value = do liftIO $ PropertySet.setProperty window name value -loadGuiScheme :: String -> MHGamer3D ()+-- | load a complete GUI scheme, see CEGUI manual for details+loadGuiScheme :: String -- ^ scheme name+ -> MHGamer3D () loadGuiScheme schemeName = do rs <- ask let gui = guiSystem rs liftIO $ SystemHG3D.schemeManagerCreate (guiSchemeManager gui) schemeName -loadGuiFont :: String -> MHGamer3D () +-- | load a GUI font+loadGuiFont :: String -- ^ font name+ -> MHGamer3D () loadGuiFont fontName = do rs <- ask let gui = guiSystem rs liftIO $ SystemHG3D.fontManagerCreate (guiFontManager gui) fontName -setGuiDefaultFont :: String -> MHGamer3D () +-- | set default GUI font+setGuiDefaultFont :: String -- ^ font name+ -> MHGamer3D () setGuiDefaultFont fontName = do rs <- ask let gui = guiSystem rs let guiS = guiGUI gui liftIO $ System.setDefaultFont guiS fontName -setGuiDefaultMouseCursor :: String -> String -> MHGamer3D () +-- | set default mouse cursor+setGuiDefaultMouseCursor :: String -- ^ scheme name, where cursor is contained in+ -> String -- ^ cursor name+ -> MHGamer3D () setGuiDefaultMouseCursor schemeName cursorName = do rs <- ask let gui = guiSystem rs let guiS = guiGUI gui liftIO $ System.setDefaultMouseCursor3 guiS schemeName cursorName -setGuiDefaultTooltip :: String -> MHGamer3D () +-- | set default tool tip+setGuiDefaultTooltip :: String -- ^ default tool tip name+ -> MHGamer3D () setGuiDefaultTooltip ttName = do rs <- ask let gui = guiSystem rs let guiS = guiGUI gui liftIO $ System.setDefaultTooltip2 guiS ttName -mapGuiElEventToFunction :: GUIElement -> String -> EventFunction a -> EventMap a -> MHGamer3D (EventMap a)-mapGuiElEventToFunction (GUIElement window) eventName function eventMap = do+-- | directly maps one specific event of one specific GUI element to a callback function+mapGuiElEventToFunction :: GUIElement -- ^ the GUI element from which the event is mapped+ -> String -- ^ the event name, see the CEGUI documentation for details+ -> EventFunction -- ^ an event function, the impact needs to be on a side effect+ -> MHGamer3D ()+mapGuiElEventToFunction (GUIElement window) eventName function = do functionTag <- getUniqueName "Event"- let newmap = mapFunctionToTag function functionTag eventMap+ mapFunctionToTag functionTag function liftIO $ EvtSF.subscribeScriptedEvent window eventName functionTag- return newmap+ return () -comboboxAddText :: GUIElement -> String -> MHGamer3D ()+-- | add one line of text as a selectable entry to a combobox+comboboxAddText :: GUIElement -- ^ GUI element, needs to be a combobox+ -> String -- ^ the entry string to add+ -> MHGamer3D () comboboxAddText (GUIElement window) itemname = do realcombo <- liftIO $ WindowSF.castWindowToCombobox window liftIO $ ListboxSF.comboboxAddItem realcombo itemname -listboxAddText :: GUIElement -> String -> MHGamer3D ()+-- | removes all lines of entries from a combobox+comboboxRemoveAllText :: GUIElement -- ^ the GUI elements, needs to be a combobox+ -> MHGamer3D ()+comboboxRemoveAllText (GUIElement window) = do+ realcombo <- liftIO $ WindowSF.castWindowToCombobox window+ liftIO $ Combobox.resetList realcombo+ +-- | add one line of text as a selectable entry to a listbox+listboxAddText :: GUIElement -- ^ GUI element, needs to be a listbox+ -> String -- ^ the entry string to add+ -> MHGamer3D () listboxAddText (GUIElement window) itemname = do reallistbox <- liftIO $ WindowSF.castWindowToListbox window liftIO $ ListboxSF.listboxAddItem reallistbox itemname+ +_getTextListOfItem reallistbox item list = do+ let (HG3DClass ptra ptrb) = item+ if ptra /= nullPtr then do+ txt <- liftIO $ ListboxItem.getText item+ let list' = list ++ [txt]+ item' <- liftIO $ Listbox.getNextSelected reallistbox item+ list'' <- _getTextListOfItem reallistbox item' list'+ return list''+ else do+ return list+ +-- | return the selected items as an array of strings+listboxGetSelectedText :: GUIElement -- ^ the GUI element, needs to be a listbox+ -> MHGamer3D [String] -- ^ the selected items as an array of strings+listboxGetSelectedText (GUIElement window) = do+ reallistbox <- liftIO $ WindowSF.castWindowToListbox window+ item <- liftIO $ Listbox.getFirstSelectedItem reallistbox+ list <- _getTextListOfItem reallistbox item ([]::[String])+ return list+ +-- | removes all lines of entries from a listbox+listboxRemoveAllText :: GUIElement -- ^ the GUI element, needs to be a listbox+ -> MHGamer3D ()+listboxRemoveAllText (GUIElement window) = do+ reallistbox <- liftIO $ WindowSF.castWindowToListbox window+ liftIO $ Listbox.resetList reallistbox
HGamer3D/APIs/Base/GUI/EngineHelper.hs view
@@ -18,10 +18,7 @@ -- EngineHelper.hs --- |Base API, GUI Module, EngineHelper Sub-Module.--- Functionality of the GUI module, which is needed for the game engine.--+-- |Supporting GUI functionality for the Base API, used internally for the game loop. module HGamer3D.APIs.Base.GUI.EngineHelper (@@ -68,10 +65,9 @@ import Control.Monad.Reader --initGUIEngine :: Bool -- ^fLog, log yes or no- -> IO (GUISystem)- +-- | initialize the GUI system, used internally+initGUIEngine :: Bool -- ^ logging flag+ -> IO (GUISystem) -- ^ GUI system object initGUIEngine fLog = do @@ -105,12 +101,16 @@ CEGUIWindowManager.setDefaultResourceGroup "Layouts" -- CEGUIScriptModule.setDefaultResourceGroup "lua_scripts" + CEGUISystemHG3D.schemeManagerCreate guischememgr "VanillaSkin.scheme" CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme" CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLook.scheme"+ CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLookWidgets.scheme"+ CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font" CEGUISystem.setDefaultFont guisystem "DejaVuSans-10"- CEGUISystem.setDefaultMouseCursor3 guisystem "WindowsLook" "MouseArrow"+ CEGUISystem.setDefaultMouseCursor3 guisystem "Vanilla-Images" "MouseArrow" CEGUISystem.setDefaultTooltip2 guisystem "WindowsLook/Tooltip" -- set standard empty gui sheet@@ -126,6 +126,7 @@ -- keypressInject +-- | injects key presses into the CEGUI engine, used internally keypressInject :: MHGamer3D () keypressInject = do rs <- ask@@ -154,7 +155,8 @@ return () else do return ()- keypressInject+ + keypressInject return () else do return ()
HGamer3D/APIs/Base/Graphics3D/Basic3D.hs view
@@ -18,24 +18,28 @@ -- Basic3D.hs --- |Base API, Graphics3D Module, Basic3D Sub-Module.--- Basic functionality of the HGamer3D engine.-+-- |Types and basic objects for 3D module of Base API. module HGamer3D.APIs.Base.Graphics3D.Basic3D ( + -- * Types Position3D (..), Scale3D (..), translate3D, Direction3D (..), Orientation3D (..), + -- * Camera Camera (..),- HGamer3D.APIs.Base.Graphics3D.Basic3D.getCamera, cameraLookAt,+ + -- * Background Colour HGamer3D.APIs.Base.Graphics3D.Basic3D.setBackgroundColour, + -- * Resource locations+ -- $audioresource+ addResourceLocationMedia, addResourceZipfileMedia, addResourceLocationGUI,@@ -61,36 +65,50 @@ import Control.Monad.State import Control.Concurrent -+-- | a type with a Position3D instance can be positioned class Position3D t where + -- | get position function position3D :: t -> MHGamer3D Vec3+ -- | set position function positionTo3D :: t -> Vec3 -> MHGamer3D () +-- | move position function translate3D :: Position3D t => t -> Vec3 -> MHGamer3D () translate3D t v = do p <- position3D t positionTo3D t ( v &+ p ) return () +-- | a type with a Scale3D instance can be scaled class Scale3D t where + -- | get scale function scale3D :: t -> MHGamer3D Vec3+ -- | set scale function scaleTo3D :: t -> Vec3 -> MHGamer3D () +-- | a type with a Direction3D instance can be oriented towards a point (Camera for example) class Direction3D t where+ -- | get direction function direction3D :: t -> MHGamer3D Vec3+ -- | set direction function directionTo3D :: t -> Vec3 -> MHGamer3D () +-- | a type with an Orientation3D instance can be oriented in space class Orientation3D t where+ -- | get orientation function orientation3D :: t -> MHGamer3D UnitQuaternion+ -- | set orientation function orientationTo3D :: t -> UnitQuaternion -> MHGamer3D () -- Camera functions -- +-- | The Camera data Camera = Camera HG3DClass +-- | get the camera object getCamera :: MHGamer3D Camera getCamera = do rs <- ask@@ -128,6 +146,8 @@ liftIO $ Camera.setOrientation c (fromNormal uq) return () +-- | set the direction in a way, that the camera looks toward a specified point+cameraLookAt :: Camera -> Vec3 -> MHGamer3D () cameraLookAt (Camera c) v = do liftIO $ Camera.lookAt c v return ()@@ -136,6 +156,7 @@ -- specific single function -- +-- | sets the background colour of the 3d drawing window setBackgroundColour :: Colour -> MHGamer3D () setBackgroundColour bgColour = do rs <- ask@@ -145,7 +166,9 @@ -- locations of media in same folder as program resides -- -addResourceLocationMedia :: String -> MHGamer3D ()+-- | adds a resource location for 3D media (Ogre)+addResourceLocationMedia :: String -- ^ path to new resource location, the path should identify a directory+ -> MHGamer3D () addResourceLocationMedia path = do rs <- ask let g3s = graphics3DSystem rs@@ -154,7 +177,9 @@ let rgm = g3sResourceGroupManager g3s liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" "General" False -addResourceZipfileMedia :: String -> MHGamer3D ()+-- | adds a resource location for 3D media (Ogre) which is a zip file+addResourceZipfileMedia :: String -- ^ path to new resource location, the path should identify a zip file+ -> MHGamer3D () addResourceZipfileMedia path = do rs <- ask let g3s = graphics3DSystem rs@@ -163,7 +188,10 @@ let rgm = g3sResourceGroupManager g3s liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "Zip" "General" False -addResourceLocationGUI :: String -> String -> MHGamer3D ()+-- | adds a resource location for GUI media (CEGUI) which is a directory+addResourceLocationGUI :: String -- ^ path to the directory with the GUI media in it+ -> String -- ^ category of GUI media, for example: Layout, Images, ...+ -> MHGamer3D () addResourceLocationGUI path category = do rs <- ask let g3s = graphics3DSystem rs@@ -172,6 +200,7 @@ let rgm = g3sResourceGroupManager g3s liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" category False +-- | finalize adding resource locations. This function needs to be called at the end of all addResourceLocation... functions. finalizeResourceLocations :: MHGamer3D () finalizeResourceLocations = do rs <- ask@@ -180,3 +209,9 @@ let rgm = g3sResourceGroupManager g3s liftIO $ ResourceGroupManager.initialiseAllResourceGroups rgm +++{-$audioresource+The resource location for audio files is currently fixed and it is not needed, to set it. The path +for audio files is \"..\/media\/audio\".+-}
HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs view
@@ -18,9 +18,7 @@ -- EngineHelper.hs --- |Base API, Graphics3D Module, EngineHelper Sub-Module.--- Functionality of the 3D module, which is needed for the game engine.-+-- | Initialization function for 3d graphics in Base API. module HGamer3D.APIs.Base.Graphics3D.EngineHelper ( @@ -85,12 +83,13 @@ 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+-- | initializes the 3d graphics module, used internally by the Base API engine module+initGraphics3D :: String -- ^ Name of the window, displayed+ -> String -- ^ SceneManager type used+ -> String -- ^ path to hgamer3d installation directory+ -> Bool -- ^ flag, show configuration dialogue+ -> Bool -- ^ flag, use directx+ -> Bool -- ^ flag, is logging enabled -> IO (Graphics3DSystem) initGraphics3D windowName sceneManagerType hg3dpath fConfig fDX fLog = do
HGamer3D/APIs/Base/Graphics3D/Light.hs view
@@ -18,19 +18,20 @@ -- Light.hs --- |Base API, Graphics3D Module, Light Sub-Module. --- Creating and managing Light. +-- | Creating and managing Light in Base API. module HGamer3D.APIs.Base.Graphics3D.Light ( + -- * Types Light (..), + + -- * Create and modify light sources HGamer3D.APIs.Base.Graphics3D.Light.setAmbientLight, createPointlight, createSpotlight, setSpotlightAngle, createDirectionalLight - ) where @@ -86,6 +87,7 @@ import HGamer3D.APIs.Base.Graphics3D.EngineHelper import HGamer3D.APIs.Base.Graphics3D.Basic3D +-- | The light. data Light = Light HG3DClass deriving (Show) instance Position3D Light where @@ -110,7 +112,8 @@ return () --- | creates a light, which fills all the room with similar strength +-- | Ambient light is present everywhere, this function creates it and sets the colour of it. +-- There is no light object, since movement, rotation, scaling would make no sense anyhow. setAmbientLight :: Colour -> MHGamer3D () setAmbientLight colour = do rs <- ask @@ -120,9 +123,9 @@ -- | creates a point light at a specific location -createPointlight :: Colour -- ^Color of the light - -> Vec3 -- ^Position, where light is created - -> MHGamer3D (Light) -- ^Return value is a graphics object +createPointlight :: Colour -- ^ Color of the light + -> Vec3 -- ^ Position, where light is created + -> MHGamer3D (Light) -- ^ The light object createPointlight (Colour t r g b) (Vec3 x y z) = do rs <- ask @@ -137,9 +140,9 @@ return eo -- | 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 -- ^ Color of the light + -> Vec3 -- ^ Position, where light is created + -> MHGamer3D (Light) -- ^ The light object createSpotlight (Colour t r g b) (Vec3 x y z) = do rs <- ask @@ -154,8 +157,8 @@ return eo -- | set the angle of a spotlight -setSpotlightAngle :: Light -- ^spotlight - -> Angle -- ^angle of the light cone, should be between 5 and 355 degree +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)) @@ -170,9 +173,9 @@ -- | 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 -- ^ Color of the light + -> Vec3 -- ^ Position, where light is created + -> MHGamer3D (Light) -- ^ The light object createDirectionalLight (Colour t r g b) (Vec3 x y z) = do rs <- ask
HGamer3D/APIs/Base/Graphics3D/Object3D.hs view
@@ -18,24 +18,23 @@ -- Object3D.hs --- |Base API, Graphics3D Module, Object3D Sub-Module. --- Creating and managing 3D objects. - +-- | Creating and managing 3D objects functionality for Base API module HGamer3D.APIs.Base.Graphics3D.Object3D ( + -- * Type Definitions Object3D (..), Material (..), - Mesh (..), + -- * Mesh creation functions createColouredLineMesh, createColouredCubeMesh, createRainbowCubeMesh, createNamedMesh, + -- * Object creation functions createObject3DFromMesh, - createSphere, createCube, createPlane, @@ -43,12 +42,13 @@ createColouredLine, createColouredCube, createRainbowCube, - loadMesh, + -- * Modify objects setObjectMaterial, combineObjects, + -- * special movements yaw3D, roll3D, pitch3D @@ -107,9 +107,10 @@ import HGamer3D.APIs.Base.Graphics3D.EngineHelper import HGamer3D.APIs.Base.Graphics3D.Basic3D - -data Object3D = SingleObject3D HG3DClass HG3DClass | -- node entity - CombinedObject3D HG3DClass [Object3D] -- node, subnodes +-- | The basic 3D object. Each object is a single instance, which can be displayed, moved, scaled, rotated, ... +-- Objects are created from meshes (templates for ojbects) or manually, by manual object creation methods. +data Object3D = SingleObject3D HG3DClass HG3DClass | -- ^ a single object, consisting of: node (Ogre) and entity (Ogre) + CombinedObject3D HG3DClass [Object3D] -- ^ a combined object,consisting of : node (Ogre) and array of sub-objects getNode :: Object3D -> HG3DClass getNode (SingleObject3D node entity) = node @@ -119,19 +120,28 @@ getEntities (SingleObject3D node entity) = [entity] getEntities (CombinedObject3D node objects) = foldl (++) [] (map getEntities objects) -data Material = NamedMaterial String +-- | The material. Define how an object is looking. +data Material = NamedMaterial String -- ^ a named material, already installed -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 +-- | The mesh. A template for creating Objects. Defines the vertices, including colour and material of an object. +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 -createNamedMesh :: String -> MHGamer3D Mesh +-- | Creates a mesh (object template) from resource +createNamedMesh :: String -- ^ mesh resource name + -> MHGamer3D Mesh -- ^ mesh createNamedMesh meshName = do return (NamedMesh meshName) -createColouredLineMesh :: Vec3 -> Vec3 -> Material -> Colour -> MHGamer3D Mesh +-- | Creates a line with a colour from start and end point (mesh as object template) +createColouredLineMesh :: Vec3 -- ^ start point + -> Vec3 -- ^ end point + -> Material -- ^ material + -> Colour -- ^ colour + -> MHGamer3D Mesh -- ^ line mesh createColouredLineMesh vStart vEnd (NamedMaterial materialName) colour = do rs <- ask let g3s = graphics3DSystem rs @@ -147,9 +157,9 @@ 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 +-- |Creates a coloured cube mesh +createColouredCubeMesh :: Material -> Colour -- ^ colour + -> MHGamer3D Mesh -- ^ cube mesh createColouredCubeMesh (NamedMaterial materialName) colour = do @@ -206,8 +216,7 @@ return (ManualMesh meshName) --- create a rainbow coloured cube with manual ojbect lib --- +-- | Creates a rainbow coloured cube mesh createRainbowCubeMesh :: MHGamer3D Mesh createRainbowCubeMesh = do @@ -258,9 +267,9 @@ liftIO $ ManualObject.convertToMesh mo meshName "General" return (ManualMesh meshName) - - -createObject3DFromMesh :: Mesh -> MHGamer3D Object3D +-- | creates a 3D object, by using a mesh template +createObject3DFromMesh :: Mesh -- ^ mesh used for creation + -> MHGamer3D Object3D -- ^ created 3d object createObject3DFromMesh mesh = do rs <- ask let g3s = graphics3DSystem rs @@ -280,42 +289,63 @@ -- return object return (SingleObject3D node entity) +-- | directly creates a sphere object createSphere :: MHGamer3D Object3D createSphere = do ob <- createObject3DFromMesh SphereMesh return (ob) +-- | directly creates a cube object createCube :: MHGamer3D Object3D createCube = do ob <- createObject3DFromMesh CubeMesh return (ob) +-- | directly creates a plane object createPlane :: MHGamer3D Object3D createPlane = do ob <- createObject3DFromMesh PlaneMesh return (ob) -loadMesh :: String -> MHGamer3D Object3D +-- | directly creates a mesh object +loadMesh :: String -- ^ name of resource of mesh + -> MHGamer3D Object3D -- ^ mesh object (not template!) loadMesh name = do ob <- createObject3DFromMesh (NamedMesh name) return (ob) -createLine :: Vec3 -> Vec3 -> Colour -> MHGamer3D Object3D +-- | directly creates a line from start and end point with colour +createLine :: Vec3 -- ^ start point + -> Vec3 -- ^ end point + -> Colour -- ^ colour + -> MHGamer3D Object3D -- ^ created line object createLine vStart vEnd colour = do mesh <- createColouredLineMesh vStart vEnd (NamedMaterial "BaseWhiteNoLighting") colour ob <- createObject3DFromMesh mesh return ob +-- | directly creates a line from start and end point with colour and material +createColouredLine :: Vec3 -- ^ start point + -> Vec3 -- ^ end point + -> Material -- ^ material + -> Colour -- ^ colour + -> MHGamer3D Object3D -- ^ created line object createColouredLine vStart vEnd material colour = do mesh <- createColouredLineMesh vStart vEnd material colour ob <- createObject3DFromMesh mesh return ob +-- | directly creates coloured cube object +createColouredCube :: Material -- ^ material + -> Colour -- ^ colour + -> MHGamer3D Object3D -- ^ created cube createColouredCube material colour = do mesh <- createColouredCubeMesh material colour ob <- createObject3DFromMesh mesh return ob +-- | directly creates a cube with rainbow colours +createRainbowCube :: MHGamer3D Object3D createRainbowCube = do mesh <- createRainbowCubeMesh ob <- createObject3DFromMesh mesh @@ -352,7 +382,10 @@ liftIO $ Node.setOrientation (getNode obj) (fromNormal uq) return () -setObjectMaterial :: Object3D -> Material -> MHGamer3D () +-- | set the material of an object +setObjectMaterial :: Object3D -- ^ 3d object + -> Material -- ^ material + -> MHGamer3D () setObjectMaterial object (NamedMaterial name) = do let entities = getEntities object sequence $ map (\entity -> liftIO $ Entity.setMaterialName entity name "General") entities @@ -361,10 +394,10 @@ -- |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. +-- input objects. Can be used to create a group and move, rotate and scale it as one entity. -combineObjects :: [Object3D] -- ^A list of objects, to be grouped - -> MHGamer3D (Object3D) -- ^The return value is a new GraphicsObject +combineObjects :: [Object3D] -- ^ A list of objects, to be grouped + -> MHGamer3D (Object3D) -- ^ The return value is a new 3d object. combineObjects listObjects = do rs <- ask
HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs view
@@ -18,10 +18,7 @@ -- PlatonObjects.hs --- |Base API, Graphics3D Module, PlatonObjects Sub-Module.--- Creating platonic bodies 3D objects.--+-- | Create platonic objects, ikosaeder and dodekaeder module HGamer3D.APIs.Base.Graphics3D.PlatonObjects ( createIkosaederMesh,@@ -130,8 +127,10 @@ return mo --createIkosaederMesh :: String -> Colour -> MHGamer3D Mesh+-- | create an ikoaeder mesh - from the mesh more objects can be created+createIkosaederMesh :: String -- ^ material name of the ikosaeder+ -> Colour -- ^ colour of the ikosaeder+ -> MHGamer3D Mesh -- ^ created mesh object createIkosaederMesh material colour = do rs <- ask@@ -171,8 +170,10 @@ return (ManualMesh meshName) - -createDodekaederMesh :: String -> Colour -> MHGamer3D Mesh+-- | create a dodekaeder mesh+createDodekaederMesh :: String -- ^ material of the dodekaeder+ -> Colour -- ^ colour of the dodekaeder+ -> MHGamer3D Mesh -- ^ created dodekaeder mesh createDodekaederMesh material colour = do rs <- ask@@ -234,12 +235,20 @@ return (ManualMesh meshName) +-- | convenience function to directly create an ikosaeder, creates a mesh and from that directly a 3d object+createIkosaeder :: String -- ^ material + -> Colour -- ^ colour+ -> MHGamer3D Object3D -- ^ ikosaeder 3d object createIkosaeder material colour = do mesh <- createIkosaederMesh material colour ob <- createObject3DFromMesh mesh return ob +-- | convenience function to directly create an dodekaeder, creates a mesh and from that directly a 3d object+createDodekaeder :: String -- ^ material+ -> Colour -- ^ colour+ -> MHGamer3D Object3D -- ^ dodekaeder 3d object createDodekaeder material colour = do mesh <- createDodekaederMesh material colour ob <- createObject3DFromMesh mesh
HGamer3D/APIs/Base/InputSystem/InputSystem.hs view
@@ -18,24 +18,20 @@ -- InputSystem.hs --- |Base API, InputSystem Module, InputSystem Sub-Module.--- The input system handles Mouse, Keyboard and Joystick Input. -+-- | Mouse, Keyboard and Joystick functionality of the Base API. module HGamer3D.APIs.Base.InputSystem.InputSystem (- -- Enums- --+ -- * Types module HGamer3D.Bindings.SFML.EnumJoystickAxis, module HGamer3D.Bindings.SFML.EnumKey, module HGamer3D.Bindings.SFML.EnumMouseButton, - -- Joystick Data Joystick (..), JoystickButton (..), - -- Joystick Functions+ -- * Joystick Functions updateJoystickStatus, getConnectedJoysticks,@@ -47,10 +43,10 @@ isJoystickButtonPressed, getJoystickAxisPosition, - -- Keyboard Functions+ -- * Keyboard Functions isKeyPressed, - -- Mouse Functions+ -- * Mouse Functions isMouseButtonPressed, getMousePosition, @@ -82,7 +78,7 @@ import Control.Monad.Reader --- Joystick Data+-- | The Joystick data Joystick = Joystick Int deriving (Eq) data JoystickButton = JoystickButton Int deriving (Eq) @@ -108,10 +104,12 @@ -- Joystick funtions -- +-- | This functions gathers the Joystick inputs. It should called frequently, for example during the gameloop, to get new values and new Joystick availability. At least it should be called before querying the Joystick values. updateJoystickStatus :: MHGamer3D () updateJoystickStatus = liftIO Joystick.update -getConnectedJoysticks :: MHGamer3D [Joystick]+-- | Get a list of connected Joysticks.+getConnectedJoysticks :: MHGamer3D [Joystick] -- ^ returns list of connected Joysticks getConnectedJoysticks = do let ns = [ x | x <- [0..15]] jns <- filterM (\jn -> do@@ -120,12 +118,16 @@ let js = map Joystick jns return js -isJoystickConnected :: Joystick -> MHGamer3D Bool+-- | Queries, if a specific Joystick is connected.+isJoystickConnected :: Joystick -- ^ the Joystick to be queried+ -> MHGamer3D Bool -- ^ True: Joystick is connected isJoystickConnected (Joystick jn) = do rv <- liftIO $ Joystick.isConnected jn return rv -getJoystickAxes:: Joystick -> MHGamer3D [EnumJoystickAxis]+-- | Queries the available axes of one specific Joystick+getJoystickAxes:: Joystick -- ^ the Joystick to be queried+ -> MHGamer3D [EnumJoystickAxis] -- ^ returns a list of available axes getJoystickAxes (Joystick j) = do axes <- filterM ( \a -> do liftIO $ Joystick.hasAxis j a) [ JoystickAxisX, JoystickAxisY, JoystickAxisZ, @@ -133,33 +135,45 @@ JoystickAxisPovX, JoystickAxisPovY ] return axes --getJoystickButtons :: Joystick -> MHGamer3D [JoystickButton]+-- | Queries the available buttons of one specific Joystick+getJoystickButtons :: Joystick -- ^ the Joystick to be queried+ -> MHGamer3D [JoystickButton] -- ^ returns a list of available buttons getJoystickButtons (Joystick j) = do jn <- liftIO $ Joystick.getButtonCount j let btns = map JoystickButton [0..(jn-1)] return btns -isJoystickButtonPressed :: Joystick -> JoystickButton -> MHGamer3D Bool+-- | Check if a specific Joystick Button is currently pressed+isJoystickButtonPressed :: Joystick -- ^ the Joystick + -> JoystickButton -- ^ the Button+ -> MHGamer3D Bool -- ^ returns True if pressed isJoystickButtonPressed (Joystick j) (JoystickButton b) = liftIO $ Joystick.isButtonPressed j b -getJoystickAxisPosition :: Joystick -> EnumJoystickAxis -> MHGamer3D Float+-- | Queries the current position of a Joystick Axis+getJoystickAxisPosition :: Joystick -- ^ the Joystick+ -> EnumJoystickAxis -- ^ the Axis+ -> MHGamer3D Float -- ^ returns the postion, ranging from -x.0 to x.0, x depending on Joystick getJoystickAxisPosition (Joystick j) ax = liftIO $ Joystick.getAxisPosition j ax -- Keyboard functions -- -isKeyPressed :: EnumKey -> MHGamer3D Bool+-- | Check if a specific keyboard key is currently pressed+isKeyPressed :: EnumKey -- ^ the key+ -> MHGamer3D Bool -- ^ True, if pressed isKeyPressed key = liftIO $ Keyboard.isKeyPressed key -- Mouse functions -- -isMouseButtonPressed :: EnumMouseButton -> MHGamer3D Bool+-- | Check if a specific mouse button is pressed+isMouseButtonPressed :: EnumMouseButton -- ^ mouse button+ -> MHGamer3D Bool -- ^ True, if pressed isMouseButtonPressed mb = liftIO $ Mouse.isButtonPressed mb -getMousePosition :: MHGamer3D (Int, Int)+-- | Queries current mouse position+getMousePosition :: MHGamer3D (Int, Int) -- ^ absolute mouse position on screen in pixel getMousePosition = liftIO Mouse2.getPosition
HGamer3D/APIs/Base/Network/EngineHelper.hs view
@@ -18,9 +18,7 @@ -- EngineHelper.hs --- |Network API, Network Module, EngineHelper Sub-Module.--+-- | Internal functions of the network functionality, used by the Base API. module HGamer3D.APIs.Base.Network.EngineHelper (@@ -45,9 +43,9 @@ import Control.Monad.Reader -+-- | intializes the network engine, used internally in the Base API. initNetworkEngine :: IO (NetworkSystem) initNetworkEngine = do- let enet = HG3DClass nullPtr nullPtr+ enet <- Enet.new let ns = (NetworkSystem enet) return ns
HGamer3D/APIs/Base/Network/Network.hs view
@@ -18,20 +18,25 @@ -- Network.hs --- |Base API, Network Module.--+-- | Network functionality of Base API module HGamer3D.APIs.Base.Network.Network (+ + -- * Overview+ -- $Overview + + -- * Types NetworkClient (..), NetworkServer (..), NetworkPacket (..),+ NetworkNode (..),+ + -- * Connection Handling createNetworkClient, createNetworkServer, connectClientToServer,- disconnectClient,- NetworkNode (..)+ disconnectClient ) where@@ -53,37 +58,61 @@ import Control.Monad.Trans import Control.Monad.Reader +-- | The network client data NetworkClient = NetworkClient HG3DClass++-- | The network server data NetworkServer = NetworkServer HG3DClass++-- | A network packet data NetworkPacket = NetworkPacket {- clientname :: String,- channel :: Int,- message :: String + clientname :: String, -- ^ the name of the client, sending the message, can be used, to reply+ channel :: Int, -- ^ the channel on which the message has been sent+ message :: String -- ^ the actual message itself } +-- | creates a network client, a client can connect to servers, but not vice versa createNetworkClient :: MHGamer3D NetworkClient createNetworkClient = do client <- liftIO $ Enet.createClient return (NetworkClient client) -createNetworkServer :: Int -> MHGamer3D NetworkServer+-- | creates a network server, a server can accept connections from clients+createNetworkServer :: Int -- ^ the port on which the server listen for connections+ -> MHGamer3D NetworkServer createNetworkServer port = do server <- liftIO $ Enet.createServer port return (NetworkServer server) -connectClientToServer :: NetworkClient -> String -> Int -> MHGamer3D Bool+-- | create a connection from a client to a server+connectClientToServer :: NetworkClient -- ^ the client, created by createNetworkClient+ -> String -- ^ the server address (regular IP addresses or NS names)+ -> Int -- ^ the port of the server to connect to+ -> MHGamer3D Bool connectClientToServer (NetworkClient client) serveraddress port = do ok <- liftIO $ EnetClient.connect client serveraddress port return ok -disconnectClient :: NetworkClient -> MHGamer3D Bool+-- | disconnect a client from a server+disconnectClient :: NetworkClient -- ^ the client+ -> MHGamer3D Bool disconnectClient (NetworkClient client) = do ok <- liftIO $ EnetClient.disconnect client return ok +-- | The network node. This TypeClass contain the methods for sending and receiving data. class NetworkNode a where- sendNetworkMessage :: a -> String -> Int -> String -> MHGamer3D ()- receiveNetworkMessages :: a -> TimeMS -> MHGamer3D [NetworkPacket]+ -- | the method to send a message+ sendNetworkMessage :: a -- ^ the node itself+ -> String -- ^ the clientname (only used, when a server send to one of his clients). Can be obtained from the first message send by the client, see above in the 'NetworkPacket' type.+ -> Int -- ^ the channel on which to send the message+ -> String -- ^ the message+ -> MHGamer3D ()+ + -- | receive pending messages+ receiveNetworkMessages :: a -- ^ the node itself+ -> TimeMS -- ^ the time in ms, which the node waits for incoming messages. If zero only delivers pending messages.+ -> MHGamer3D [NetworkPacket] -- ^ array of received network packages _transformPackage :: HG3DClass -> MHGamer3D NetworkPacket@@ -141,3 +170,14 @@ +{-$Overview++The commuication model of this library is easy. There are clients and servers. Clients can connect to servers but not whise versa. So each server can have multiple clients. Both are nodes. Nodes can send and receive messages. ++Upon connection the port is defined on which servers and clients communicate with each other.++In addition to the port, channels exists, to enable parallel streams of messages on different channels.++A client has a name, to identify him. This name is communicated in the first packet from the client to the server. The server needs the client name, to send a package to the specific client. The client does not need a name for the server, since there exists only one connection from the client to one server.++-}
HGamer3D/APIs/Base/Physics/EngineHelper.hs view
@@ -18,7 +18,7 @@ -- EngineHelper.hs --- |Physics API, Physics Module, EngineHelper Sub-Module.+-- | Internal functionality of pyhsics functionality for Base API. module HGamer3D.APIs.Base.Physics.EngineHelper@@ -49,7 +49,7 @@ import Control.Monad.Reader -+-- | initialize the physics system, only used internally in Base API. initPhysicsEngine :: IO PhysicsSystem initPhysicsEngine = do
HGamer3D/APIs/Base/Physics/Physics.hs view
@@ -18,7 +18,7 @@ -- Physics.hs --- |Base API, Physics Module.+-- | Physics functionality of Base API. This module is likely to change in the near future and not well documented. module HGamer3D.APIs.Base.Physics.Physics@@ -150,7 +150,7 @@ orientation3D (Body body) = do dir <- liftIO $ Motion.getQuaternion body- return ((toU . mkNormal . fromQ) dir)+ return $ (mkU . fromQ) dir orientationTo3D (Body body) dir = do liftIO $ Motion.setQuaternion body ((toQ . fromU) dir)
+ HGamer3D/APIs/FRP.hs view
@@ -0,0 +1,46 @@+-- 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.++-- WireAPI.hs++-- |HGamer3D FRP API: an arrowized functional reactive programming API, based on the netwire library (<http://hackage.haskell.org/package/netwire>).++module HGamer3D.APIs.FRP++(+ -- * Types+ module HGamer3D.APIs.FRP.Types,+ + -- * Main FRP API functionality+ module HGamer3D.APIs.FRP.GUI,+ module HGamer3D.APIs.FRP.Graphics3D,+ module HGamer3D.APIs.FRP.InputSystem,+ module HGamer3D.APIs.FRP.Network,++ -- * re-exported Base API+ module HGamer3D.APIs.Base+)++where++import HGamer3D.APIs.Base+import HGamer3D.APIs.FRP.GUI+import HGamer3D.APIs.FRP.Graphics3D+import HGamer3D.APIs.FRP.InputSystem+import HGamer3D.APIs.FRP.Network+import HGamer3D.APIs.FRP.Types
+ HGamer3D/APIs/FRP/GUI.hs view
@@ -0,0 +1,283 @@+{-# LANGUAGE Arrows #-} + +-- | The GUI functionality of the FRP API +module HGamer3D.APIs.FRP.GUI +( + -- * basic Wires + guiEventW, + guiSetPropW, + guiGetPropW, + buttonW, + staticTextW, + + -- * editable GUI element wires + -- $EditGUIWire + editBoxW, + floatEditBoxW, + checkBoxW, + radioButtonW, + sliderW, + spinnerW, + listBoxW, + comboBoxW, + + -- * Wires which do not fire on setting values by program + -- $FireOnlyOnGUI + editBoxW', + floatEditBoxW', + checkBoxW', + radioButtonW', + sliderW', + spinnerW' +) + +where + +import HGamer3D.APIs.Base as Base +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import Control.Monad.Trans + +import Control.Monad.Identity (Identity) +import Control.Wire +import Prelude hiding ((.), id) + +import Control.Monad.Reader +import Control.Monad.State + +import Data.IORef +import HGamer3D.APIs.FRP.Types + + +-- functions to put gui events into a list and pop them out again, as well as fire, when there is an event in it +-- + +_gatherGUIEvents :: IORef [Base.Event] -> EventFunction +_gatherGUIEvents ref event = do + list <- liftIO $ readIORef ref + liftIO $ writeIORef ref (list ++ [event]) + return () + +_popGUIEvent :: IORef [Base.Event] -> MHGamer3D (Maybe Base.Event) +_popGUIEvent ref = do + list <- liftIO $ readIORef ref + case list of + [] -> return Nothing + (x : xs) -> do + liftIO $ writeIORef ref xs + return $ Just x + +_eventFunctionFired :: IORef [Base.Event] -> Time -> a -> MHGamer3D (Either () a) +_eventFunctionFired ref t a = do + evt <- _popGUIEvent ref + case evt of + Just (GUIEvent name sender window) -> do + return (Right a) + Nothing -> do + return (Left ()) + + +-- new approach, more elemental wires, with better granularity +-- + +-- first create an event receiving wire for a GUIElement and a specific event + +-- | Constructor for a wire, which delivers events from a GUI element +guiEventW :: GUIElement -- ^ GUI element + -> String -- ^ name of event + -> GameWire a a -- ^ event wire, which fires in case of event occurrence +guiEventW widget eventname = switch (mkStateM True (\t (a,s) -> do + if s then do + -- create the event IORef + ref <- liftIO $ newIORef [] + -- then map the events to a function, which gather events into this ref + mapGuiElEventToFunction widget eventname (_gatherGUIEvents ref) + -- finally create the wire + return $ (Right (mkFixM (_eventFunctionFired ref)), False) + else do + return (Left (), False))) id + + + +-- then create a wire which gets and sets a property of the underlying GUI element + + +-- | Constructor for a wire, which sets a specific property on occurrence +guiSetPropW :: GUIElement -- ^ GUI element + -> String -- ^ property name + -> GameWire String String -- ^ wire, which sets the property and returns the value +guiSetPropW widget propname = mkFixM (\t s -> do + setGuiElProperty widget propname s + return $ Right s) + +-- | Constructor for a wire, which gets a specific property from a GUI element +guiGetPropW :: GUIElement -- ^ GUI element + -> String -- ^ property name + -> GameWire a String -- ^ wire, which returns property value as string, input is ignored +guiGetPropW widget propname = mkFixM (\t s -> do + s' <-getGuiElProperty widget propname + return $ Right s') + +_createGUIValueW :: GUIElement -> String -> String -> (GameWire a String, GameWire String String) +_createGUIValueW widget propname changename = (valueW . changeW, setValueW) where + changeW = guiEventW widget changename + valueW = guiGetPropW widget propname + setValueW = guiSetPropW widget propname + +-- | Constructor for two wires, which in combination provide the functionality of an editable box GUI element. +editBoxW :: GUIElement -- ^ GUI element (should be an editbox) + -> (GameWire a String, GameWire String String) -- ^ Two wires as return value, a wire, which fires when the value changed and a setter wire, which sets the text of the editbox. +editBoxW widget =_createGUIValueW widget "Text" "TextChanged" + +-- | Constructor for two wires, which provide the functionality of an editable box for float values as a GUI element. +floatEditBoxW :: GUIElement -- ^ GUI element (should be an editbox) + -> (GameWire a Float, GameWire Float Float) -- ^ Two wires as return value, a value changed wire and a setter wire. +floatEditBoxW widget = (fchanged, fsetter) where + sToF str = if length arr > 0 then fst $ arr !! 0 else 0.0 where + arr = (reads str) :: [(Float, String)] + toFW = mkFix (\t s -> Right $ sToF s) + showF = mkFix (\t f -> Right $ show f) + (changed, setter) = editBoxW widget + fchanged = toFW . changed + fsetter = toFW . setter . showF + +-- | Constructur for a wire, which can change a static text GUI element (a setter). +staticTextW :: GUIElement -- ^ GUI element (should be a static text, or any widget with a "Text" property. + -> (GameWire String String) -- ^ the returned wire +staticTextW widget = guiSetPropW widget "Text" + +_bst = mkFix (\time b -> if b then Right "True" else Right "False") +_stb = mkFix (\time st -> if st == "True" then Right True else Right False) + +-- | Consructor for two wires, which deliver the checkbox GUI element functionality. +checkBoxW :: GUIElement -- ^ GUI element (should be a checkbox) + -> (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire +checkBoxW widget = (changed, setter) where + (changed', setter') = _createGUIValueW widget "Selected" "CheckStateChanged" + changed = _stb . changed' + setter = _stb . setter' . _bst + +-- | Constructor for two wires, which deliver the radiobuttion GUI element functionality. +radioButtonW :: GUIElement -- ^ GUI element (should be a checkbox) + -> (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire +radioButtonW widget = (changed, setter) where + (changed', setter') = _createGUIValueW widget "Selected" "SelectStateChanged" + changed = _stb . changed' + setter = _stb . setter' . _bst + +_fst = mkFix (\time f -> Right $ show f) +_stf = mkFix (\time st -> Right $ read st) + +-- | Constructor for two wires, which deliver the slider GUI element functionality. +sliderW :: GUIElement -- ^ GUI element (should be a slider) + -> (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire +sliderW widget = (changed, setter) where + (changed', setter') = _createGUIValueW widget "CurrentValue" "ValueChanged" + changed = _stf . changed' + setter = _stf . setter' . _fst + +-- | Constructur for two wires, which deliver the spinner GUI element functionality. +spinnerW :: GUIElement -- ^ GUI element (which should be a spinner) + -> (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire +spinnerW = sliderW + +-- | Constructure for an event wire, which deliver the button functionality. It simply fires the event on button press. +buttonW :: GUIElement -- ^ GUI element (which should be a button) + -> GameWire a a -- ^ event wire +buttonW widget = guiEventW widget "Clicked" + +_listboxGetSelectedTextW :: GUIElement -> GameWire a [String] +_listboxGetSelectedTextW widget = mkFixM (\t s -> do + t <- listboxGetSelectedText widget + return $ Right t) + +_listboxSetTextW :: GUIElement -> GameWire [String] [String] +_listboxSetTextW widget = mkFixM (\t ls -> do + listboxRemoveAllText widget + mapM (listboxAddText widget) ls + return (Right ls)) + +-- | Constructur for two wires, which deliver the listbox functionality. +listBoxW :: GUIElement -- ^ GUI element, which should be a list box + -> (GameWire a [String], GameWire [String] [String]) -- ^ Two wires as return value, a value changed wire and a wire + -- which sets the listbox. Those wires are slightly differently since the setter sets the list of choices, not the + -- actual selection on them. The changed value wire delivers an array of selections on each change. +listBoxW widget = (changed, setter) where + changeW = guiEventW widget "ItemSelectionChanged" + valueW = _listboxGetSelectedTextW widget + changed = valueW . changeW + setter = _listboxSetTextW widget + +_comboboxSetTextW :: GUIElement -> GameWire [String] [String] +_comboboxSetTextW widget = mkFixM (\t ls -> do + comboboxRemoveAllText widget + mapM (comboboxAddText widget) ls + return (Right ls)) + +-- | Constructor for two wires, which deliver the combobox functionality. +comboBoxW :: GUIElement -- ^ GUI element, which should be a combobox + -> (GameWire a String, GameWire [String] [String]) -- ^ Two wires, one value changed wire, which delivers just one selection and a setter wire, with which the selectable elements can be set. The possibility, to edit the selected element is not included in the functionality. +comboBoxW widget = (changed, setter) where + changeW = guiEventW widget "ListSelectionAccepted" + valueW = guiGetPropW widget "Text" + changed = valueW . changeW + setter = _comboboxSetTextW widget + + +_changeOnlyOnInputWire (cw, sw) = do + rb <- liftIO $ newIORef False + let sw' = mkFixM (\t a -> do + liftIO $ writeIORef rb True + return (Right a)) . sw + let cw' = mkFixM (\t a -> do + b <- liftIO $ readIORef rb + liftIO $ writeIORef rb False + if b then return (Left ()) else return (Right a)) . cw + return (cw', sw') + + +-- | Constructor for two wires, which in combination provide the functionality of an editable box GUI element. Version, which does not deliver a change event, if value set by program. +editBoxW' :: GUIElement -- ^ GUI element (should be an editbox) + -> MHGamer3D (GameWire a String, GameWire String String) -- ^ Two wires as return value, a wire, which fires when the value changed and a setter wire, which sets the text of the editbox. +editBoxW' el = _changeOnlyOnInputWire (editBoxW el) + +-- | Constructor for two wires, which provide the functionality of an editable box for float values as a GUI element. Version, which does not deliver a change event, if value set by program. +floatEditBoxW' :: GUIElement -- ^ GUI element (should be an editbox) + -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ Two wires as return value, a value changed wire and a setter wire. +floatEditBoxW' el = _changeOnlyOnInputWire (floatEditBoxW el) + +-- | Consructor for two wires, which deliver the checkbox GUI element functionality. Version, which does not deliver a change event, if value set by program. +checkBoxW' :: GUIElement -- ^ GUI element (should be a checkbox) + -> MHGamer3D (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire +checkBoxW' el = _changeOnlyOnInputWire (checkBoxW el) + +-- | Constructor for two wires, which deliver the radiobuttion GUI element functionality. Version, which does not deliver a change event, if value set by program. +radioButtonW' :: GUIElement -- ^ GUI element (should be a checkbox) + -> MHGamer3D (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire +radioButtonW' el = _changeOnlyOnInputWire (radioButtonW el) + +-- | Constructor for two wires, which deliver the slider GUI element functionality. Version, which does not deliver a change event, if value set by program. +sliderW' :: GUIElement -- ^ GUI element (should be a slider) + -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire +sliderW' el = _changeOnlyOnInputWire (sliderW el) + +-- | Constructur for two wires, which deliver the spinner GUI element functionality. Version, which does not deliver a change event, if value set by program. +spinnerW' :: GUIElement -- ^ GUI element (which should be a spinner) + -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire +spinnerW' el = _changeOnlyOnInputWire (spinnerW el) + + +{-$EditGUIWire + The standard GUI wire creation functions are not in the MHGamer3D monad. This enables their usage in an easy way in GHCI. + The editable elements are composed of two different types of functions, which might occurr at different times and therefore + the corresponding wires are two, in each case. One type of functions sets the content of the editable element. For example + the setter functions set the text of an editbox or the position of a slider. The other type of functions deliver an event + in the case the value has been changed from the GUI user. The simple wires below also deliver a change event in case + the value has been set by the programmer with the setter. Below are more complex wires (still with the same API) which do + not deliver a change event, in case the programmer sets the value of a GUI element. +-} + +{-$FireOnlyOnGUI + Below functions do not deliver a change event in case the programmer sets the value by the setter wire. This enables much more + easy usage in case of circular dependencies between GUI elements. The creation functions are in the MHGamer3D monad. +-}
+ HGamer3D/APIs/FRP/Graphics3D.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE Arrows #-} + +-- | 3D graphics functionality of the FRP API +module HGamer3D.APIs.FRP.Graphics3D + +( + scaleW, + translateW, + scaleToW, + directionW, + directionToW, + positionW, + positionToW, + orientationW, + orientationToW +) + +where + +import HGamer3D.APIs.Base as Base +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import Control.Monad.Trans + +import Control.Monad.Identity (Identity) +import Control.Wire +import Prelude hiding ((.), id) + +import Control.Monad.Reader +import Control.Monad.State + +import HGamer3D.APIs.FRP.Types +import Data.IORef + +-- | A wire, which delivers each cycle the position, input is ignored +positionW :: Position3D ob => ob -- ^ positionable object + -> GameWire a Vec3 -- ^ wire which delivers the position +positionW ob = mkFixM (\t x -> do + vec <- position3D ob + return (Right vec)) + +-- | A wire, which sets and returns the position +positionToW :: Position3D ob => ob -- ^ positionable object + -> GameWire Vec3 Vec3 -- ^ wire which sets and returns the position +positionToW ob = mkFixM (\t vec -> do + positionTo3D ob vec + return (Right vec)) + +-- | A wire, which translates each cycle the position +translateW :: Position3D ob => ob -- ^ positionable object + -> GameWire Vec3 Vec3 -- ^ wire, which translates the object +translateW ob = mkFixM (\t v -> do + translate3D ob v + return (Right v)) + +-- | A wire, which delivers each cycle the direction, input is ignored +directionW :: Direction3D ob => ob -- ^ object with direction + -> GameWire a Vec3 -- ^ wire, which delivers the direction +directionW ob = mkFixM (\t x -> do + vec <- direction3D ob + return (Right vec)) + +-- | A wire, which sets the direction +directionToW :: Direction3D ob => ob -- ^ directionable object + -> GameWire Vec3 Vec3 -- ^ wire, which sets direction +directionToW ob = mkFixM (\t v -> do + directionTo3D ob v + return (Right v)) + +-- | A wire, which delivers each cycle the scale, input is ignored +scaleW :: Scale3D ob => ob -- ^ scalable object + -> GameWire a Vec3 -- ^ wire, which delivers the scale +scaleW ob = mkFixM (\t x -> do + vec <- scale3D ob + return (Right vec)) + +-- | A wire, which sets the scale +scaleToW :: Scale3D ob => ob -- ^ scalable object + -> GameWire Vec3 Vec3 -- ^ a wire, which sets and returns the scale +scaleToW ob = mkFixM (\t v -> do + scaleTo3D ob v + return (Right v)) + +-- | A wire, which delivers each cycle the orientation, input is ignored +orientationW :: Orientation3D ob => ob -- ^ object with orientation + -> GameWire a UnitQuaternion -- ^ wire, which delivers the orientation, as a unit quaternion +orientationW ob = mkFixM (\t x -> do + ori <- orientation3D ob + return (Right ori)) + +-- | A wire, which sets the orientation +orientationToW :: Orientation3D ob => ob -- ^ object with orientation + -> GameWire UnitQuaternion UnitQuaternion -- ^ a wire which sets and returns the orientation +orientationToW ob = mkFixM (\t ori -> do + orientationTo3D ob ori + return (Right ori)) +
+ HGamer3D/APIs/FRP/InputSystem.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE Arrows #-} + +-- | Input device functionality of FRP API. Mouse, Joystick, Keyboard input is handled. +module HGamer3D.APIs.FRP.InputSystem + +( + -- * Joystick functionality + connectedJoysticksW, + joystickButtonW, + joystickButtonPressedW, + joystickAxisPositionW, + + -- * Mouse functionality + mouseButtonW, + mouseButtonPressedW, + mousePositionW, + + -- * Keyboard functionality + keyW, + keyPressedW +) + +where + +import HGamer3D.APIs.Base as Base +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import Control.Monad.Trans + +import Control.Monad.Identity (Identity) +import Control.Wire +import Prelude hiding ((.), id) + +import Control.Monad.Reader +import Control.Monad.State + +import Data.IORef +import HGamer3D.APIs.FRP.Types + +-- Joystick +----------- + +-- | Wire, which delivers the connected joysticks +connectedJoysticksW :: GameWire a [Joystick] +connectedJoysticksW = mkFixM (\t a -> do + updateJoystickStatus + js <- getConnectedJoysticks + return (Right js)) + +_joystickButtonStatus :: Joystick -> JoystickButton -> GameWire a Bool +_joystickButtonStatus joystick button = mkFixM (\t a -> do + updateJoystickStatus + pressed <- isJoystickButtonPressed joystick button + return (Right pressed)) + +-- | Wire, which fires, when joystick button is pressed +joystickButtonW :: Joystick -- ^ joystick + -> JoystickButton -- ^ joystick button, to be checked + -> GameWire a a -- ^ event, which fires, when button pressed +joystickButtonW joystick button = ifW (_joystickButtonStatus joystick button) id (inhibit ()) + +-- | Wire, which fires after a button down, button up sequence of a joystick button +joystickButtonPressedW :: Joystick -- ^ joystick + -> JoystickButton -- ^ joystick button, to be checked + -> GameWire a a -- ^ event, which fires, after button has been pressed once +joystickButtonPressedW joystick button = ifW ((edge (\a -> not a)) . (_joystickButtonStatus joystick button)) id (inhibit ()) + +-- | Wire, which delivers the value of a joystick axis +joystickAxisPositionW :: Joystick -- ^ joystick + -> EnumJoystickAxis -- ^ joystick axis, to be checked + -> GameWire a Float -- ^ delivers position of joystick axis, input value ignored +joystickAxisPositionW joystick axis = mkFixM (\t a -> do + updateJoystickStatus + rval <- getJoystickAxisPosition joystick axis + return (Right rval)) + + +-- Mouse +-------- + +_mouseButtonStatus :: EnumMouseButton -> GameWire a Bool +_mouseButtonStatus button = mkFixM (\t a -> do + pressed <- isMouseButtonPressed button + return (Right pressed)) + +-- | Wire, which fires, when mouse button is pressed +mouseButtonW :: EnumMouseButton -- ^ mouse button, to be checked + -> GameWire a a -- ^ event, which fires, when button pressed +mouseButtonW button = ifW (_mouseButtonStatus button) id (inhibit ()) + +-- | Wire, which fires after a button down, button up sequence of a mouse button +mouseButtonPressedW :: EnumMouseButton -- ^ mouse button, to be checked + -> GameWire a a -- ^ event, which fires, after button has been pressed once +mouseButtonPressedW button = ifW ((edge (\a -> not a)) . (_mouseButtonStatus button)) id (inhibit ()) + +-- | Wire, which delivers the value of the mouse position +mousePositionW :: GameWire a (Int, Int) -- ^ delivers position of mouse, x, y in absolute screen pixels, input value ignored +mousePositionW = mkFixM (\t a -> do + rval <- getMousePosition + return (Right rval)) + + + +-- Keyboard +----------- + +_keyStatus :: EnumKey -> GameWire a Bool +_keyStatus key = mkFixM (\t a -> do + val <- isKeyPressed key + return (Right val)) + +-- | Wire, which delivers an event, if key is pressed +keyW :: EnumKey -- ^ the key, to be checked + -> GameWire a a -- ^ the event wire +keyW key = ifW (_keyStatus key) id (inhibit ()) + +-- | Wire, which delivers an event after a key down, key up sequence +keyPressedW :: EnumKey -- ^ the key, to be checked + -> GameWire a a -- ^ the event wire +keyPressedW key = ifW ((edge (\a -> not a)) . (_keyStatus key)) id (inhibit ()) + + +
+ HGamer3D/APIs/FRP/Network.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Arrows #-} + +module HGamer3D.APIs.FRP.Network + +( +) + +where + +import HGamer3D.APIs.Base as Base +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import Control.Monad.Trans + +import Control.Monad.Identity (Identity) +import Control.Wire +import Prelude hiding ((.), id) + +import Control.Monad.Reader +import Control.Monad.State + +import Data.IORef +import HGamer3D.APIs.FRP.Types + +
+ HGamer3D/APIs/FRP/Types.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE Arrows #-} + +module HGamer3D.APIs.FRP.Types + +( + mkRefWire, + swapRefWire, + MHGamer3D2, + GameWire +) + +where + +import HGamer3D.APIs.Base as Base +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import Control.Monad.Trans + +import Control.Monad.Identity (Identity) +import Control.Wire +import Prelude hiding ((.), id) + +import Control.Monad.Reader +import Control.Monad.State + +import Control.Concurrent.MVar +import Data.IORef + +type MHGamer3D2 = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) +type GameWire a b = Wire () MHGamer3D2 a b + +-- function to keep a reference to a wire + +mrefWireFunction :: Time -> (a, MVar (Wire e MHGamer3D2 a b)) -> MHGamer3D (Either e b, (MVar (Wire e MHGamer3D2 a b))) +mrefWireFunction dt (a, s) = do + wire <- liftIO $ takeMVar s + (r, wire') <- stepWire wire dt a + liftIO $ putMVar s wire' + return (r, s) + +mkRefWire :: Wire e MHGamer3D2 a b -> IO (MVar (Wire e MHGamer3D2 a b), (Wire e MHGamer3D2 a b)) +mkRefWire wire = do + ref <- newMVar wire + let wire' = mkStateM ref mrefWireFunction + return (ref, wire') + +swapRefWire :: MVar (Wire e MHGamer3D2 a b) -> Wire e MHGamer3D2 a b -> IO (Wire e MHGamer3D2 a b) +swapRefWire ref wire = swapMVar ref wire
− HGamer3D/BaseAPI.hs
@@ -1,68 +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.---- BaseAPI.hs---- |This module includes the basic API of HGamer3D--module HGamer3D.BaseAPI--(- module HGamer3D.Data.Colour,- module HGamer3D.Data.Vector,- module HGamer3D.Data.Angle,-- module HGamer3D.APIs.Base.Audio.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,- - module HGamer3D.APIs.Base.GUI.BasicGUI,- module HGamer3D.APIs.Base.Physics.Physics,- module HGamer3D.APIs.Base.Network.Network- -)--where--import HGamer3D.Data.Colour-import HGamer3D.Data.Vector-import HGamer3D.Data.Angle--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 HGamer3D.APIs.Base.Physics.Physics-import HGamer3D.APIs.Base.Network.Network--import Control.Monad.Trans (liftIO)-
LICENSE view
@@ -1,4 +1,6 @@-(c) 2011-2012 Peter Althainz +(c) 2011-2013 Peter Althainz + +The files are part of HGamer3D (www.hgamer3d.org) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.