packages feed

HGamer3D 0.3.3 → 0.4.0

raw patch · 20 files changed

+1766/−88 lines, 20 filesdep +HGamer3D-Audiodep +HGamer3D-InputSystemdep +HGamer3D-Networkdep ~HGamer3D-Datadep ~HGamer3D-GUIdep ~HGamer3D-Graphics3D

Dependencies added: HGamer3D-Audio, HGamer3D-InputSystem, HGamer3D-Network, clock, containers, ghc-prim, hashable, hashtables, split

Dependency ranges changed: HGamer3D-Data, HGamer3D-GUI, HGamer3D-Graphics3D, HGamer3D-WinEvent

Files

HGamer3D.cabal view
@@ -1,5 +1,5 @@ Name:                HGamer3D
-Version:             0.3.3
+Version:             0.4.0
 Synopsis:            A Game Engine for the Haskell Programmer
 Description:         
 	HGamer3D is a game engine for developing 3D games in the programming 
@@ -7,7 +7,6 @@ 	sound, input device handling, gui programming and other areas and make
 	those functions available for the Haskell programmer by providing  
 	a Haskell API on top of that. HGamer3D is available on Windows and Linux.
-	This package includes 3D Graphics, GUI and WinEvent.
 	
 License:             OtherLicense
 License-file:        LICENSE
@@ -19,10 +18,23 @@ Category:            Game Engine
 Extra-source-files:  Setup.hs 
 
+Flag Audio
+  Description: Enable Audio
+  Default: True
+
+Flag Network
+  Description: Enable Network
+  Default: True
+
+Flag InputSystem
+  Description: Enable Joystick, Mouse, Keyboard Polling
+  Default: True
+
 Library
-  Build-Depends:     base >= 3 && < 5, HGamer3D-Data >= 0.3.0 && < 0.4.0, HGamer3D-Graphics3D >= 0.3.0 && < 0.4.0, HGamer3D-WinEvent >= 0.3.0 && < 0.4.0, HGamer3D-GUI >= 0.3.0 && < 0.4.0 
+  Build-Depends:     base >= 3 && < 5, ghc-prim, split, clock, containers, hashtables, hashable, HGamer3D-Data >= 0.4.0 && < 0.5.0, HGamer3D-Graphics3D >= 0.4.0 && < 0.5.0, HGamer3D-WinEvent >= 0.4.0 && < 0.5.0, HGamer3D-GUI >= 0.4.0 && < 0.5.0 
 
-  Exposed-modules:   HGamer3D
+  Exposed-modules:   HGamer3D.Engine.Internal.Component, HGamer3D.Engine.Internal.ComponentType, HGamer3D.Engine.Internal.Entity, HGamer3D.Engine.Internal.System, HGamer3D.Engine.Internal.SystemGraphics3D, HGamer3D.Engine.Internal.SystemEvent, HGamer3D.Engine.Internal.GameLoop, HGamer3D.Engine.Internal.Event, HGamer3D.Engine.Schema.EventReceiver, HGamer3D.Engine.Schema.EventChannel, HGamer3D.Engine.EcsAPI, HGamer3D.Engine.BaseAPI, HGamer3D.Internal.Engine, HGamer3D.GUI.EcsAPI, HGamer3D.Graphics3D.EcsAPI
+
   Other-modules:     
 
   c-sources:         
@@ -33,3 +45,16 @@   Include-dirs:      . 
   build-depends:     
   extra-libraries:   
+
+  if flag(audio)
+    build-depends: HGamer3D-Audio >= 0.4 && < 0.5
+    exposed-modules: HGamer3D.Audio.Internal.SystemAudio, HGamer3D.Audio.EcsAPI, HGamer3D.Internal.AudioModule
+
+  if flag(network)
+    build-depends: HGamer3D-Network >= 0.4 && < 0.5
+--    exposed-modules: HGamer3D.Network.EcsAPI
+
+  if flag(inputsystem)
+    build-depends: HGamer3D-InputSystem >= 0.4 && < 0.5
+--    exposed-modules: HGamer3D.InputSystem.EcsAPI
+
− HGamer3D.hs 
@@ -1,84 +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) 2014 Peter Althainz------ Licensed under the Apache License, Version 2.0 (the "License");--- you may not use this file except in compliance with the License.--- You may obtain a copy of the License at------     http://www.apache.org/licenses/LICENSE-2.0------ Unless required by applicable law or agreed to in writing, software--- distributed under the License is distributed on an "AS IS" BASIS,--- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.--- See the License for the specific language governing permissions and--- limitations under the License.---- HGamer3D Main Module------- | HGamer3D - A game engine for the Haskell Programmer-module HGamer3D --(-  HG3DEvent (..),-  -  module HGamer3D.Graphics3D,-  module HGamer3D.WinEvent,-  module HGamer3D.GUI,--  loopHGamer3D,-  initHGamer3D,-  exitHGamer3D-  -  ) where--  import HGamer3D.Graphics3D hiding (initHGamer3D, loopHGamer3D, exitHGamer3D)-  import HGamer3D.WinEvent hiding (initHGamer3D, loopHGamer3D, exitHGamer3D)-  import HGamer3D.GUI-  import qualified System.Info as SI--  data HG3DEvent = EventWindow SDLEvent | EventGUI [GUIEvent]--  exitHGamer3D :: Graphics3DSystem -> GUISystem -> IO ()-  exitHGamer3D g3ds guis = do -     exitGraphics3D g3ds---  -- the game loops works in a way, that window events are much faster processed then -  -- update of rendering -> all events needs to be cleared, then next renderOneFrame is processed--  loopHGamer3D :: Graphics3DSystem -> GUISystem -> IO (Maybe HG3DEvent, Bool)-  loopHGamer3D g3ds guis = do--        -- this one is quite tricky, on Linux we need to call the message loop in addition to WinEvent!-        if SI.os /= "mingw32" then graphics3DPumpWindowMessages else return ()-        i <- checkQuitReceived--        evt <- pollWinEvent-        case evt of-           Just sdlEvt -> do-                             injectWinEventToGUI guis sdlEvt  -- inject event into gui-                             return (Just (EventWindow sdlEvt), (i == 1) )-           _ -> do-                  gevts <- pollGUIEvents guis-                  if length gevts > 0 then-                     return (Just (EventGUI gevts), (i == 1) )-                     else do-                        renderOneFrame g3ds-                        return (Nothing, (i == 1) )---  initHGamer3D :: String -- ^ Window Title-                  -> Bool -- ^ Flag show config dialogue-                  -> Bool -- ^ Flag logging enabled-                  -> Bool -- ^ show Graphics Cursor-                  -> IO (Graphics3DSystem, GUISystem, Camera, Viewport)-  initHGamer3D windowTitle fConfigDialogue fLog fGraphicsCursor = do-        success <- initWinEvent [WEV_INIT_EVENTS, WEV_INIT_TIMER, WEV_INIT_VIDEO]-        (g3ds, camera, viewport, window) <- initGraphics3D windowTitle "DefaultSceneManager" fConfigDialogue fLog-        win <- attachToWindow window-        guis <- initGUI fLog fGraphicsCursor-        return (g3ds, guis, camera, viewport)
+ HGamer3D/Audio/EcsAPI.hs view
@@ -0,0 +1,35 @@+-- 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) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/AudioModule/EcsAPI+--++module HGamer3D.Audio.EcsAPI++(+  AudioListener (..),+  AudioSource (..),+  AudioSourceParameter (..),++  runSystemAudio+  +) where++  import HGamer3D.Audio.Schema.AudioListener+  import HGamer3D.Audio.Schema.AudioSource+  import HGamer3D.Audio.Internal.SystemAudio
+ HGamer3D/Audio/Internal/SystemAudio.hs view
@@ -0,0 +1,101 @@+{-# Language StandaloneDeriving #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Audio/Internal/SystemAudio.hs+++module HGamer3D.Audio.Internal.SystemAudio++where++import Control.Concurrent.MVar+import qualified Data.Map as M+import Data.Maybe+import Data.Typeable+import Data.Dynamic+import Data.Hashable+import qualified Data.HashTable.IO as HT++import qualified HGamer3D.Data as D++import HGamer3D.Engine.Internal.Event+import HGamer3D.Engine.Internal.Entity+import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.System++import qualified HGamer3D.Audio.Internal.Base as A+import qualified HGamer3D.Audio.Schema.AudioSource as AS+import qualified HGamer3D.Audio.Schema.AudioListener as AL+++-- | the Audio System of the Entity-Component-System World+data ECSAudio = ECSAudio {+  audioSlots :: ListAndCache AS.AudioSlots A.AudioSlots,+  positions :: ListAndCache D.Position ()+  }++_handleEvent aslots evt = do+      let (A.AudioSlots map schema) = aslots+      case evt of+        AudioEvt (PlaySound slot) -> do+          let mAS = (M.lookup slot map)+          case mAS of+            Just as -> A.playAudioSource as+            Nothing -> return ()+        AudioEvt (StopSound slot) -> do+          let mAS = (M.lookup slot map)+          case mAS of+            Just as -> A.stopAudioSource as+            Nothing -> return ()++instance System ECSAudio where++    addEntity system entity = do+      lacAdd entity (audioSlots system)+      lacAdd entity (positions system)+      return system++    removeEntity system entity = do+      lacRemove entity (audioSlots system)+      lacRemove entity (positions system)+      return system++    initializeSystem = do+      audioSlots <- lacInitialize CTASl+      positions <- lacInitialize CTPos+      return $ (ECSAudio audioSlots positions)++    stepSystem system = do+      let handleUserEvents evts aslots = do+            mapM (_handleEvent aslots) evts+            return ()+      lacApplyChanges (audioSlots system) A.audioSlots A.updateAudioSlots A.removeAudioSlots handleUserEvents lacHandleC2UEvents+      let update' pos edata schema = D.positionTo edata pos +      lacApplyOtherChanges (positions system) (audioSlots system) update'+      return (system, False)+      +    shutdownSystem system = return ()++runSystemAudio :: D.GameTime -> IO ECSAudio+runSystemAudio sleepT = runSystem sleepT++
+ HGamer3D/Engine/BaseAPI.hs view
@@ -0,0 +1,37 @@+-- 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) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D BaseAPI Module+--++-- | Engine module - BaseAPI of HGamer3D+module HGamer3D.Engine.BaseAPI++(+  HG3DEvent (..),+  AudioEvent (..),+  GUIFormEvent (..),++  initHGamer3D,+  freeHGamer3D,+  stepHGamer3D,+  +  ) where++  import HGamer3D.Engine.Internal.GameLoop+  import HGamer3D.Engine.Internal.Event
+ HGamer3D/Engine/EcsAPI.hs view
@@ -0,0 +1,100 @@+-- 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) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D EcsAPI Module+--++-- | HGamer3D - A game engine for the Haskell Programmer, this module includes the common modules for the ECS API.+--   ECS is the Entity - Component - System++module HGamer3D.Engine.EcsAPI+(+  -- $Ecs++  -- * Component+  -- $Component+  Component,+  ComponentType (..),+  newC,+  readC,+  valC,+  isTypeC,+  updateC,+  idC,+  +  +  -- * Entity+  -- $Entity+  Entity,+  entity,+  (#:),+  (#?),+  (#),++  -- * System+  -- $System+  System,++  ECSEventQueues,+  runSystemEvent,+  HG3DEvent (..),+  GUIFormEvent (..),+  ApplicationEvent (..),+  AudioEvent (..),+  +  sendEvent,+  receiveEvents,++  module HGamer3D.Engine.Schema.EventReceiver,+  module HGamer3D.Engine.Schema.EventChannel,++  SomeSystem,+  (#+),+  addToWorld,+  removeFromWorld,+  +) where++import HGamer3D.Internal.Engine+import HGamer3D.Engine.Schema.EventReceiver+import HGamer3D.Engine.Schema.EventChannel++++++{- $Ecs+An Entity-Component-System is a specific architecture for building the object model of a game engine. It has been evolved to address some shortcomings of the traditional OO style of building game objects, which led to large and inflexible object inheritance trees, which did not cover well the needs of flexible game entity organization. Interestingly whereas the traditional OO model does not have a good and usable representation in the functional world, the ECS system does, since it is founded on a data driven model, something which plays well with functional architectures.++A full explanation of ECS is beyond this documentation, you can easily find it by searching for the term in the Internet. Here we describe shortly the implementation of the ECS model in HGamer3D.++The components of an ECS are describing the basic data building blocks, from which game entities are build. Typical components for a game entity are for example its 3D picture, its position, the sounds associated with it, its animations, its hit count and health and so on. Important to acknowledge is that a component is only the data part of that, not the behaviour part as in OO objects. Due to the modular structure of components, they might be also referred to as properties. Game entities now are build, by assigning an identity to the entity and by giving it a number of components or properties. This architecture by composition gives much more flexible systems, than designing large object hierarchies. Finally the behaviour of the entities in different contexts are implemented in the so called systems.+-}++{- $Entity++-}++{- $Component+The component implements something like the most granular modifiable state in the game engine world. This state is accessible by multiple threads and it has an associated id, with which it can be uniquely identified. (The id is implemented as a StableName). Since the overall mechanism is somehow poll based, we need a mechanism to determine changed values fast, this is done by the timestamp mechanism, which allows, to detect changed values fast in exchange to a small penalty on the cost of doing a change.+-}+++{- $System++-}
+ HGamer3D/Engine/Internal/Component.hs view
@@ -0,0 +1,135 @@+{-# Language StandaloneDeriving, DeriveDataTypeable, DeriveGeneric, PatternGuards #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Component.hs++-- | the Component in Entity-Component-System++module HGamer3D.Engine.Internal.Component+where++import Data.Dynamic+import Data.Typeable+import Control.Concurrent.MVar+import System.Mem.StableName+import GHC.Generics (Generic)+import Data.Hashable+import Data.Maybe+import System.Clock++import HGamer3D.Engine.Internal.Event++deriving instance Generic TimeSpec+instance Hashable TimeSpec++data StampedValue a = SV a Int+     deriving (Typeable)++instance Eq a => Eq (StampedValue a) where+  (==) (SV val1 h1) (SV val2 h2) = if h1 == h2 then True else val1 == val2++_stamp :: a -> IO (StampedValue a)+_stamp val = do+  tstamp <- (getTime Monotonic >>= return . hash)+  return $ SV val tstamp++fromStamped :: StampedValue a -> a+fromStamped (SV val _) = val++type ComponentId = StableName Dynamic++data Component = Component {+  componentData :: Dynamic,+  componentId :: ComponentId,+  componentType :: TypeRep,+  componentU2CEvents :: MVar [HG3DEvent],+  componentC2UEvents :: MVar [HG3DEvent]+} ++instance Eq Component where+    c1 == c2 = (idC c1) == (idC c2)++newC :: Typeable a => a -> IO Component+newC val = do+  tval <- _stamp val+  mv <- newMVar tval+  let dyn = toDyn mv+  ident <- makeStableName dyn+  evtsU2C <- newMVar []+  evtsC2U <- newMVar []+  return (Component dyn ident (typeOf val) evtsU2C evtsC2U)++readC :: Typeable a => Component -> IO (Maybe (StampedValue a))+readC (Component dyn _ _ _ _)+    | Just mv  <- fromDynamic dyn = do+                    val <- takeMVar mv+                    putMVar mv val+                    return $ Just val+    | otherwise = do+              return Nothing++valC :: Typeable a => Component -> IO a+valC c = readC c >>= return . fromStamped . fromJust++isTypeC :: Typeable a => a -> Component -> Bool+isTypeC val (Component dyn _ tr _ _) = (typeOf val == tr)+  +updateC :: Typeable a => Component -> (a -> a) -> IO ()+updateC (Component dyn _ _ _ _) f +    | Just mv  <- fromDynamic dyn = do+                    val <- (takeMVar mv >>= (return . fromStamped))+                    newTVal <- _stamp (f val)+                    putMVar mv newTVal+                    return ()+    | otherwise = do+              return ()+    +idC :: Component -> ComponentId+idC (Component _ ident _ _ _) = ident+++_pushU2CEvents :: Component -> [HG3DEvent] -> IO ()+_pushU2CEvents c newEvts = do+  let mv = (componentU2CEvents c)+  evts <- takeMVar mv+  putMVar mv (evts ++ newEvts)++_popU2CEvents :: Component -> IO [HG3DEvent]+_popU2CEvents c = do+  let mv = (componentU2CEvents c)+  evts <- takeMVar mv+  putMVar mv []+  return evts++_pushC2UEvents :: Component -> [HG3DEvent] -> IO ()+_pushC2UEvents c newEvts = do+  let mv = (componentC2UEvents c)+  evts <- takeMVar mv+  putMVar mv (evts ++ newEvts)++_popC2UEvents :: Component -> IO [HG3DEvent]+_popC2UEvents c = do+  let mv = (componentC2UEvents c)+  evts <- takeMVar mv+  putMVar mv []+  return evts++
+ HGamer3D/Engine/Internal/ComponentType.hs view
@@ -0,0 +1,44 @@+{-# OPTIONS_HADDOCK hide #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Internal/ECS/ComponentType Module+--++module HGamer3D.Engine.Internal.ComponentType++where++-- | Possible Component Types, which are known, this list needs to be extended, if+--   additional components are introduced. Each component can occur only once in+--   an Entity.+data ComponentType =   CTPos    -- ^ Position+                     | CTOri    -- ^ Orientation+                     | CTSiz    -- ^ Size+                     | CTFig    -- ^ Figure+                     | CTASl    -- ^ Audio Slots +                     | CTALs    -- ^ Audio Listener+                     | CTCam    -- ^ Cameras+                     | CTLig    -- ^ Light+                     | CTScP    -- ^ Scene Parameter+                     | CTEvR    -- ^ Event Receiver +                     | CTEvC    -- ^ Event Channel+                     | CTGFo    -- ^ GUI Forms+                       deriving (Eq, Ord, Show)++
+ HGamer3D/Engine/Internal/Entity.hs view
@@ -0,0 +1,102 @@+{-# Language StandaloneDeriving #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Entity.hs++-- | the Entity in Entity-Component-System++module HGamer3D.Engine.Internal.Entity+where++import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.Event++import Control.Concurrent.MVar+import qualified Data.Map as M+import Data.Maybe+import Data.Typeable+import System.Mem.StableName++type EntityId = StableName (M.Map ComponentType Component)+data Entity = Entity {+  entityCMap :: (M.Map ComponentType Component),+  entityId :: EntityId ,+  entityU2CEvents :: MVar [HG3DEvent],+  entityC2UEvents :: MVar [HG3DEvent]+}++--+-- pure Data functions, creating, traversing and getting components from entities+--++entity :: [(ComponentType, IO Component)] -> IO Entity+entity inList  = do+  outList <- mapM (\(c, val) -> do+                     val' <- val+                     return (c, val')) inList+  let cMap = M.fromList outList+  eId <- makeStableName cMap+  evtsU2C <- newMVar []+  evtsC2U <- newMVar []+  return $ Entity cMap eId evtsU2C evtsC2U++instance Eq Entity where+  e1 == e2 = (entityId e1) == (entityId e2)++idE :: Entity -> EntityId+idE (Entity _ eId _ _) = eId++sendEvent :: Entity -> HG3DEvent -> IO ()+sendEvent (Entity map _ evtsU2C _) event = do+  evts <- takeMVar evtsU2C+  putMVar evtsU2C (evts ++ [event])++_popEntityU2CEvents :: Entity -> IO [HG3DEvent]+_popEntityU2CEvents (Entity map _ evtsU2C _) = do+  evts <- takeMVar evtsU2C+  putMVar evtsU2C []+  return evts++receiveEvents :: Entity -> IO [HG3DEvent]+receiveEvents (Entity map _ _ evtsC2U) = do+  evts <- takeMVar evtsC2U+  putMVar evtsC2U []+  return evts++_pushEntityC2UEvents :: Entity -> [HG3DEvent] -> IO ()+_pushEntityC2UEvents (Entity map _ _ evtsC2U) events = do+  evts <- takeMVar evtsC2U+  putMVar evtsC2U (evts ++ events)++(#:) :: Typeable a => ComponentType -> a -> (ComponentType, IO Component)+(#:) ec val = (ec, newC val)++(#?) :: Entity -> ComponentType -> Maybe Component+(Entity map _ _ _) #? name = M.lookup name map+infix 8 #?++(#) :: Entity -> ComponentType -> Component+e # name = fromJust (e #? name)+infix 8 #+++
+ HGamer3D/Engine/Internal/Event.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Internal/Event Module+--++module HGamer3D.Engine.Internal.Event+where++import HGamer3D.WinEvent.BaseAPI+import HGamer3D.GUI.BaseAPI+import qualified HGamer3D.GUI.Schema.Widget as W+import qualified HGamer3D.GUI.Schema.Form as F+import Data.Dynamic++data AudioEvent = PlaySound String+                | StopSound String+                  deriving (Show)++data GUIFormEvent = FormSetValue [(String, F.FormValue)]+                  | FormValueChange String [(String, F.FormValue)]+                  | FormButtonClick String+                    deriving (Show)++data ApplicationEvent = AppQuit+     		      deriving (Show)++data HG3DEvent = WindowEvt SDLEvent+               | GUIEvt GUIEvent                         -- ^ Low level GUI evts+               | FormEvt GUIFormEvent                    -- ^ High level GUI evts, directly form related+               | AudioEvt AudioEvent+               | UserEvt Dynamic+	       | AppEvt ApplicationEvent+                 deriving (Show)+                 ++
+ HGamer3D/Engine/Internal/GameLoop.hs view
@@ -0,0 +1,99 @@+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Internal/GameLoop Module+--++-- | HGamer3D - A game engine for the Haskell Programmer, this module includes the implementation of the gameloop and initialization routines. This is an internal module, the public API is in HGamer3D.BaseAPI.+module HGamer3D.Engine.Internal.GameLoop++(+  HG3DEvent (..),+  +  initHGamer3D,+  freeHGamer3D,+  stepHGamer3D,+  +  ) where++  import HGamer3D.Data+  import HGamer3D.Util++  import HGamer3D.Graphics3D.BaseAPI+  import HGamer3D.WinEvent.BaseAPI+  import HGamer3D.GUI.BaseAPI+  +  import HGamer3D.Engine.Internal.Event++  -- need a couple of internal functions from base modules, to implement game loop+  -- import HGamer3D.Internal.Graphics3D (renderOneFrame, graphics3DPumpWindowMessages, checkQuitReceived)+  import HGamer3D.GUI.Internal.Base (pollGUIEvent, initGUI, injectWinEventToGUI)+  import HGamer3D.WinEvent.Internal.Base (attachToWindow)++  import qualified System.Info as SI++  freeHGamer3D :: Graphics3DSystem -> GUISystem -> IO ()+  freeHGamer3D g3ds guis = do +     freeGraphics3D g3ds+++  -- | Game Loop+  -- The game loop works in a way, that window events are much faster processed then +  -- update of rendering -> all events needs to be cleared, then next renderOneFrame is processed+  -- after that the call returns.+  stepHGamer3D :: Graphics3DSystem -- ^ the Graphics System+                  -> GUISystem     -- ^ the GUI System+                  -> GameTime      -- ^ last time called+                  -> IO ([HG3DEvent], GameTime, Bool) -- ^ list of Events received, quit flag (True if quit received)+                  +  stepHGamer3D g3ds guis lastTime = do++    now <- getTime+    let tdiff = now - lastTime+    injectGUITimeDelta guis tdiff+    let getEvents evts = do+        mWinEvt <- pollWinEvent+        case mWinEvt of+           Just winEvt -> do+             injectWinEventToGUI guis winEvt  -- inject event into gui+             getEvents (evts ++ [WindowEvt winEvt])+           Nothing -> do+             mGuiEvt <- pollGUIEvent guis+             case mGuiEvt of+               Just guiEvt -> getEvents (evts ++ [GUIEvt guiEvt])+               Nothing -> return evts++    qFlag <- stepGraphics3D g3ds+    events <- getEvents []+    +    return (events, now, qFlag)+     +  initHGamer3D :: String -- ^ Window Title+                  -> Bool -- ^ Flag show config dialogue+                  -> Bool -- ^ Flag logging enabled+                  -> Bool -- ^ show Graphics Cursor+                  -> IO (Graphics3DSystem, GUISystem, GameTime)+  initHGamer3D windowTitle fConfigDialogue fLog fGraphicsCursor = do+        success <- initWinEvent [WEV_INIT_EVENTS, WEV_INIT_TIMER, WEV_INIT_VIDEO]+        (g3ds, window) <- initGraphics3D windowTitle "DefaultSceneManager" fConfigDialogue fLog+        win <- attachToWindow window+        guis <- initGUI fLog fGraphicsCursor+        now <- getTime+        return (g3ds, guis, now)
+ HGamer3D/Engine/Internal/System.hs view
@@ -0,0 +1,345 @@+{-# Language StandaloneDeriving, ExistentialQuantification #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- System.hs++-- | the System in Entity-Component-System++module HGamer3D.Engine.Internal.System++where++import Control.Concurrent+import Control.Concurrent.MVar+import qualified Data.Map as M+import Data.Maybe+import Data.Typeable+import Data.IORef++import HGamer3D.Data as D+import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.Entity+import HGamer3D.Engine.Internal.Event++import HGamer3D.Engine.Schema.EventReceiver++import System.Mem.StableName+import Data.Hashable+import qualified Data.HashTable.IO as HT+++-- the class of data types which have a pure and engine implementation and which can be updated+++{- ----------------------------------------------------------+               utility functions for systems+   ---------------------------------------------------------- -}++-- Entity List++data EntityList = EntityList {+  entAddList :: MVar [Entity],+  entRemoveList :: MVar [Entity],+  entities :: IORef [Entity]+}++entInitialize :: IO EntityList +entInitialize = do+      al <- newMVar []+      rl <- newMVar []+      es <- newIORef []+      return $ EntityList al rl es++entAdd :: EntityList -> Entity -> IO EntityList+entAdd esys entity = do+      al <- takeMVar (entAddList esys)+      putMVar (entAddList esys) (al ++ [entity])+      return esys++entRemove :: EntityList -> Entity -> IO EntityList+entRemove esys entity = do+      rl <- takeMVar (entRemoveList esys)+      putMVar (entRemoveList esys) (rl ++ [entity])+      return esys++stepEntityList :: EntityList -> IO EntityList+stepEntityList esys = do+      -- add entities from other thread+      al <- takeMVar (entAddList esys)+      putMVar (entAddList esys) []+      modifyIORef (entities esys) (\oldList -> oldList ++ al)++      -- remove entities from other thread+      rl <- takeMVar (entRemoveList esys)+      putMVar (entRemoveList esys) []+      modifyIORef (entities esys) (filter (\el -> not (el `elem` rl))) ++      return esys++  ++-- List and Cache++type IdHashTable v = HT.BasicHashTable EntityId v++data ListAndCache schema engine = ListAndCache {+  -- access from two threads+  lacAddList :: MVar [(EntityId, Component)],      +  lacRemoveList :: MVar [EntityId],   +  -- access from g3ds thread only+  lacList ::  IORef [(EntityId, Component)],    +  lacCache :: IdHashTable (engine, StampedValue schema),+  lacType :: ComponentType+  }++-- initialize+lacInitialize :: (Typeable schema, Eq schema) => ComponentType -> IO (ListAndCache schema engine)+lacInitialize ct = do+  listAdd <- newMVar []+  listRemove <- newMVar []+  listIO <- newIORef []+  cache <- HT.new+  return (ListAndCache listAdd listRemove listIO cache ct)+  +-- add component for entry+lacAdd :: (Typeable schema, Eq schema) => Entity -> ListAndCache schema engine -> IO ()+lacAdd e lac = do+  oldList <- takeMVar (lacAddList lac)+  let mCom = e #? (lacType lac)+  let newList = case mCom of+        Just com -> ((idE e, com) : oldList)+        Nothing -> oldList+  putMVar (lacAddList lac) newList++-- add component for delete+lacRemove :: (Typeable schema, Eq schema) => Entity -> ListAndCache schema engine -> IO ()+lacRemove e lac = do+  oldList <- takeMVar (lacRemoveList lac)+  putMVar (lacRemoveList lac) (idE e : oldList)++-- empty event handling functions, for re-use in case no event handling is needed+lacHandleU2CEvents :: [HG3DEvent] -> engine -> IO ()+lacHandleU2CEvents evts eng= return ()++lacHandleC2UEvents :: engine -> IO [HG3DEvent]+lacHandleC2UEvents eng = return []++-- step system, apply all changes, this is for main components, where direct responsibility exists+lacApplyChanges :: (Typeable schema, Eq schema) =>+                   ListAndCache schema engine          -- ^ list and cache data structure+                   -> (schema -> IO engine)            -- ^ create function for new entries+                   -> (engine -> schema -> IO engine)  -- ^ update function for changing entries+                   -> (engine -> IO ())                -- ^ remove functions for removed entries+                   -> ([HG3DEvent] -> engine -> IO ()) -- ^ handle user events (U2C) function+                   -> (engine -> IO [HG3DEvent] )      -- ^ handle component events (C2U) function+                   -> IO ()+lacApplyChanges lac create update remove handleU2CEvents handleC2UEvents = do+  -- insert+  insertList <- takeMVar (lacAddList lac)+  mapM (\(eid, c) -> do+           stampedVal <- readC c >>= return . fromJust+           let val = fromStamped stampedVal+           engineVal <- create val+           HT.insert (lacCache lac) eid (engineVal, stampedVal)+           modifyIORef (lacList lac) ( (:) (eid, c) )+           ) insertList+  putMVar (lacAddList lac) []+  +  -- remove+  removeList <- takeMVar (lacRemoveList lac)+  mapM (\eid -> do+           -- get cached value and remove+           mCacheVal <- HT.lookup (lacCache lac) eid+           case mCacheVal of+             Just (engineVal, stampedCacheVal) -> do+               remove engineVal+               HT.delete (lacCache lac) eid+             Nothing -> error "HGamer3D.Engine.Internal.System.applyAnyChanges: cache value not found"+           -- remove from current list+           modifyIORef (lacList lac) (filter (\(eid', c) -> eid /= eid'))+           ) removeList+  putMVar (lacRemoveList lac) []++  -- apply changes from compenents, taken from stamp+  currList <- readIORef (lacList lac)+  mapM (\(eid, c) -> do+           -- handle Events, user event received+           userEvts <- _popU2CEvents c+           mCacheVal <- HT.lookup (lacCache lac) eid+           case mCacheVal of+             Just (engineVal, stampedCacheVal) -> do+               -- event handling+               handleU2CEvents userEvts engineVal+               comEvents <- handleC2UEvents engineVal+               _pushC2UEvents c comEvents+               newStampedVal <- readC c >>= return . fromJust+               if stampedCacheVal /= newStampedVal then do+                 newEngineVal <- update engineVal (fromStamped newStampedVal)+                 HT.insert (lacCache lac) eid (newEngineVal, newStampedVal)+                 return ()+                 else return ()+             Nothing -> return (error "HGamer3D.Engine.Internal.System.applyAnyChanges: cache value not found")+           return ()+             ) currList+  return ()++-- step changes, apply all changes for supplementary components, where responsibility reside in other components+lacApplyOtherChanges :: (Typeable schema, Eq schema) =>+                        ListAndCache schema ()                   -- ^ this component, where add and remove functions are done (list ops only)+                        -> ListAndCache schema' engine'              -- ^ the main component, which is influenced by this component+                        -> (schema -> engine' -> schema' -> IO ())   -- ^ update function, updates from this component to main engine+                        -> IO ()+lacApplyOtherChanges lac lac' update' = do+  -- insert+  insertList <- takeMVar (lacAddList lac)+  mapM (\(eid, c) -> do+           stampedVal <- readC c >>= return . fromJust+           let val = fromStamped stampedVal+           HT.insert (lacCache lac) eid ((), stampedVal) -- empty engine value, only need to store stampedValue+	   -- do one time change in main component+           mMainCacheVal <- HT.lookup (lacCache lac') eid+           case mMainCacheVal of+               Just (engineMainVal, stampedMainCacheVal) -> update' val engineMainVal (fromStamped stampedMainCacheVal)+	       Nothing -> return ()+           modifyIORef (lacList lac) ( (:) (eid, c) )+           ) insertList+  putMVar (lacAddList lac) []+  +  -- remove+  removeList <- takeMVar (lacRemoveList lac)+  mapM (\eid -> do+           -- get cached value and remove+           mCacheVal <- HT.lookup (lacCache lac) eid+           case mCacheVal of+             Just (engineVal, stampedCacheVal) -> do+               HT.delete (lacCache lac) eid+             Nothing -> error "HGamer3D.Engine.Internal.System.applyAnyChanges: cache value not found"+           -- remove from current list+           modifyIORef (lacList lac) (filter (\(eid', c) -> eid /= eid'))+           ) removeList+  putMVar (lacRemoveList lac) []++  -- apply changes from compenents, taken from stamp+  currList <- readIORef (lacList lac)+  mapM (\(eid, c) -> do+           -- handle Events+           mCacheVal <- HT.lookup (lacCache lac) eid+           case mCacheVal of+             Just (engineVal, stampedCacheVal) -> do -- engineVal is ()+               newStampedVal <- readC c >>= return . fromJust+               if stampedCacheVal /= newStampedVal then do+                 let newVal = fromStamped newStampedVal+                 -- lookup engine val and val from main current value+                 mMainCacheVal <- HT.lookup (lacCache lac') eid+                 case mMainCacheVal of+                   Just (engineMainVal, stampedMainCacheVal) -> update' newVal engineMainVal (fromStamped stampedMainCacheVal)+                   Nothing -> return (error "HGamer3D.Engine.Internal.System.applyAnyChanges: cache value not found")+                 HT.insert (lacCache lac) eid ((), newStampedVal)+                 return ()+                 else return ()+             Nothing -> return (error "HGamer3D.Engine.Internal.System.applyAnyChanges: cache value not found")+           return ()+             ) currList+  return ()++  +-- the system of entity component system, in general a system has internal state+-- entities can be added to it and the system has a step function, to run it++class System a where+      addEntity :: a -> Entity -> IO a+      removeEntity :: a -> Entity -> IO a+      stepSystem :: a -> IO (a, Bool)+      initializeSystem :: IO a+      shutdownSystem :: a -> IO ()++      runSystem :: D.GameTime -> IO a+      runSystem stepT = do+        mv <- newEmptyMVar+        forkOS $ (\mv' -> do+                     status <- initializeSystem+                     putMVar mv' status+                     let runS s = do+                            nowT <- getTime+                            (s', qFlag) <- stepSystem s+                            if qFlag then do+                              shutdownSystem s'+                              return ()+                              else do+                                nowT' <- getTime+                                let timeUsed = nowT' - nowT+                                if timeUsed < stepT then do+                                  threadDelay ((fromIntegral . usec) (stepT - timeUsed) )+                                  else do+                                    return ()+                                runS s'+                     runS status+                     ) mv+        status' <- takeMVar mv+        return status'+++-- management of systems+--+        +data SomeSystem = forall a . System a => SomeSystem a++(#+) :: forall a. System a => a -> [SomeSystem] -> [SomeSystem]+a #+ as = (SomeSystem a : as) +infixr #+++-- ECS World functions, to manage entities in systems++addToWorld :: [SomeSystem] -> Entity -> IO ()+addToWorld systems e = mapM (f e) systems >> return () where+  f e (SomeSystem s) = addEntity s e >> return ()++removeFromWorld :: [SomeSystem] -> Entity -> IO ()+removeFromWorld systems e = mapM (f e) systems >> return () where+  f e (SomeSystem s) = removeEntity s e >> return ()+    +filterEventType :: [EventType] -> [HG3DEvent] -> [HG3DEvent]+filterEventType types events = let+  filterOneType evt evttype = case evttype of+    AudioEvents -> case evt of+      (AudioEvt _) -> True+      _ -> False+    WinEvents -> case evt of+      (WindowEvt _) -> True+      _ -> False+    GUIEvents -> case evt of+      (GUIEvt _) -> True+      _ -> False+    FormEvents -> case evt of+      (FormEvt _) -> True+      _ -> False+    UserEvents -> case evt of+      (UserEvt _ ) -> True+      _ -> False+    ApplicationEvents -> case evt of+      (AppEvt _) -> True+      _ -> False+    AllEvents -> True+    _ -> False+  filterAllTypes evttypes evt = length (filter id (map (filterOneType evt) evttypes)) > 0+  in filter (filterAllTypes types) events+
+ HGamer3D/Engine/Internal/SystemEvent.hs view
@@ -0,0 +1,185 @@+{-# Language StandaloneDeriving #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Internal/ECS/SystemEvent.hs++{- | the Event System of the Entity-Component-System World+The event system is handling the event distribution and is responsible to send incoming events and distribute them to the receivers. The guidelines how this works are along the main ideas of an ECS in general, each component should be separated from each other. The event system is the only one, which knows about more than one component with regards to events. Also the user interface in the end should be simple. ++* User Interface Functionality++Users receive and send events over the entity interface with the functions receiveEvents and sendEvent. Sent events are distributed to the components in the entity as needed. Events coming from components are only processed if a ReceiveEvent component is added to the entity with the filter criteria, which events should be received. An additional channel component is existing, which allows sending events to a channel and receiving events from a channel.++* Scenarios, how the Event System works in detail++In general users are only interacting with the entity functions, which fill and empty the U2C and C2U queues of the entity. Component systems (with the exception of the EventSystem itself) are only receiving and sending into the component queues. The distribution of events between entities and components are done by the EventSystem, based on two principle mechanisms: ++** From user to component (U2C)+U2C events are placed into the appropriate components directly. The event is placed in the incoming event queue of the entity by the sendEvent function. The event systems distributes them towards the target component of the same entity. into the U2C queue. The target component picks it up from the U2C queue and handles it. Examples: play audio sound, receiving component is the audio component. GUI Form set values, receiving component is the GUI component (within Graphics3D), which handles it.++** From component to user (C2U)+C2U events are not automatically placed into the entity for receipt by the user. Instead all C2U events are placed into an exising receiving component. From this component only the events of the current filter criteria are put into the entity C2U event queue. Besides of that processing is similar as in the U2C case. The component places incoming events into the component event queue, the C2U queue, from there the event system puts them into the receiving component queue. ++** Channels+Channels are just separate components, which work the following: user events are put in the component channel U2C queue. From there they are stored into a cross entity channel storage structure. All the events in the channel structure are distributed to the channel components in the C2U queue. From there they might be picked up by receiving components, as done in the case of other components also.+-}++module HGamer3D.Engine.Internal.SystemEvent++where++import Control.Concurrent.MVar+import Data.Maybe+import Data.Typeable+import Data.Dynamic+import Data.IORef++import HGamer3D.Engine.Internal.Entity+import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.System+import HGamer3D.Engine.Internal.Event++import Data.Hashable+import qualified Data.HashTable.IO as HT+++import qualified HGamer3D.Data as D+import qualified HGamer3D.Internal.Graphics3D as Gr+import qualified HGamer3D.Engine.BaseAPI as E+import qualified HGamer3D.GUI.BaseAPI as GU+import qualified HGamer3D.WinEvent.BaseAPI as WinEvt++import HGamer3D.Graphics3D.Schema.Figure+import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Material+import HGamer3D.Graphics3D.Schema.Camera+import HGamer3D.Graphics3D.Schema.Light+import HGamer3D.Graphics3D.Schema.Scene+import HGamer3D.Engine.Schema.EventReceiver+import HGamer3D.Engine.Schema.EventChannel++data ECSEventQueues = ECSEventQueues {+  entList :: EntityList,+  namedQueues ::  HT.BasicHashTable String [HG3DEvent]+}++instance System ECSEventQueues where++    initializeSystem = do+      el <- entInitialize+      nq <- HT.new+      return $ (ECSEventQueues el nq) ++    addEntity esys entity = do+      entAdd (entList esys) entity+      return esys++    removeEntity esys entity = do+      entRemove (entList esys) entity+      return esys+    +    stepSystem esys = do++      -- add/remove entities from other thread+      stepEntityList (entList esys)++      es <- readIORef (entities (entList esys))+      +      -- map over all entities and handle the events+      mapM (\entity -> do++               -- U2C mechanism, distribute incoming user events to components which wants them+               +               u2cEvts <- _popEntityU2CEvents entity+               -- audio evts+               let audioEvts = filterEventType [AudioEvents] u2cEvts+               case (entity #? CTASl) of+                 Nothing -> return ()+                 Just com -> _pushU2CEvents com audioEvts+               -- channels+               case (entity #? CTEvC) of+                 Nothing -> return ()+                 Just com -> _pushU2CEvents com u2cEvts+               -- GUI Forms+               let guiEvts = filterEventType [FormEvents] u2cEvts+               case (entity #? CTGFo) of+                 Nothing -> return ()+                 Just com -> _pushU2CEvents com guiEvts++               -- Channel handling, send U2C events to channel+                  +               case (entity #? CTEvC) of+                 Nothing -> return ()+                 Just com -> do+                   EventChannel channel <- readC com >>= return . fromStamped . fromJust+                   evts <- _popU2CEvents com+                   mOldEvents <- HT.lookup (namedQueues esys) channel+                   case mOldEvents of+                     Just oldEvents -> HT.insert (namedQueues esys) channel (oldEvents ++ evts)+                     Nothing -> HT.insert (namedQueues esys) channel evts+                     _ -> return ()+                 +               -- C2U mechanism, distribute incoming component events to entity+                 +               case (entity #? CTEvR) of+                 Nothing -> return ()+                 Just com -> do+                   (EventReceiver eventtypes) <- readC com >>= return . fromStamped . fromJust+                   c2uEvts <- _popC2UEvents com+                   let evts = filterEventType eventtypes c2uEvts+                   _pushEntityC2UEvents entity evts+                     +           ) es++      -- remark channel handling: the correct sequence is as follows, first+      -- handle all entities and put user events into channel storage (above).+      -- Then (second) send all channels to receivers (C2U), which is below.+      -- Third, delete queues.++      -- Channel handling, send all queue content to all receivers+      -- clear all channels, after sending/receiving+      namedQueueList <- HT.toList (namedQueues esys)+      mapM (\(channel, events) -> do+               events <- HT.lookup (namedQueues esys) channel >>= return . fromJust+               HT.insert (namedQueues esys) channel []+               mapM (\entity -> do+                        case (entity #? CTEvC) of+                          Nothing -> return ()+                          Just comChannel -> do+                            EventChannel channel' <- readC comChannel >>= return . fromStamped . fromJust+                            if channel == channel' then do+                              case (entity #? CTEvR) of+                                Nothing -> return ()+                                Just comReceiver -> _pushC2UEvents comReceiver events+                              else return ()+                    ) es+           ) namedQueueList+      +      return (esys, False)+     ++    shutdownSystem esys = return ()++runSystemEvent :: D.GameTime -> IO ECSEventQueues+runSystemEvent sleepT = runSystem sleepT++
+ HGamer3D/Engine/Internal/SystemGraphics3D.hs view
@@ -0,0 +1,270 @@+{-# Language StandaloneDeriving #-}+{-# OPTIONS_HADDOCK hide #-}++-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Internal/ECS/SystemGraphics3D.hs++-- | the Graphics3D System of the Entity-Component-System World++module HGamer3D.Engine.Internal.SystemGraphics3D++where++import Control.Concurrent.MVar+import qualified Data.Map as M+import Data.Maybe+import Data.Typeable+import Data.Dynamic++import HGamer3D.Engine.Internal.Entity+import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.System++import Data.IORef+import Data.Hashable+import qualified Data.HashTable.IO as HT+import Data.List.Split+++import qualified HGamer3D.Data as D+import qualified HGamer3D.Internal.Graphics3D as Gr+import qualified HGamer3D.Engine.BaseAPI as E+import qualified HGamer3D.Engine.Internal.Event as Evt++import qualified HGamer3D.GUI.BaseAPI as GU+import qualified HGamer3D.WinEvent.BaseAPI as WinEvt++import HGamer3D.Graphics3D.Schema.Figure+import HGamer3D.Graphics3D.Schema.Geometry+import HGamer3D.Graphics3D.Schema.Material+import HGamer3D.Graphics3D.Schema.Camera+import HGamer3D.Graphics3D.Schema.Light+import HGamer3D.Graphics3D.Schema.Scene+import HGamer3D.Engine.Schema.EventReceiver+import HGamer3D.GUI.Schema.Form++++-- the system of entity component system, in general a system has internal state+-- entities can be added to it and the system has a step function, to run it+-- Systems are self-contained, so they can be run in a thread and manage their state themselves+++data ECSGraphics3D = ECSGraphics3D {+      -- status of graphics engine+      g3d :: (Gr.Graphics3DSystem, GU.GUISystem),+      receivers :: ListAndCache EventReceiver (),++      -- figures+      figures :: ListAndCache Figure (Gr.Object3D Figure),+      posfig :: ListAndCache D.Position (),+      orifig :: ListAndCache D.Orientation (),++      -- cameras+      cameras :: ListAndCache Camera Gr.Camera,+      poscam :: ListAndCache D.Position (),+      oricam :: ListAndCache D.Orientation (),++      -- lights+      lights :: ListAndCache Light Gr.Light,+      poslig :: ListAndCache D.Position (),+      orilig :: ListAndCache D.Orientation (),++      -- gui forms+      guiforms :: ListAndCache Form GU.GUIEngineData,++      -- scene parameter+      scenepars :: ListAndCache SceneParameter (),++      -- gametime+      gt :: IORef D.GameTime+      }++instance System ECSGraphics3D where++    addEntity ecsg3d entity = do+      lacAdd entity (receivers ecsg3d)+      +      lacAdd entity (figures ecsg3d)+      lacAdd entity (posfig ecsg3d)+      lacAdd entity (orifig ecsg3d)+      +      lacAdd entity (cameras ecsg3d)+      lacAdd entity (poscam ecsg3d)+      lacAdd entity (oricam ecsg3d)++      lacAdd entity (lights ecsg3d)+      lacAdd entity (poslig ecsg3d)+      lacAdd entity (orilig ecsg3d)++      lacAdd entity (guiforms ecsg3d)+      lacAdd entity (scenepars ecsg3d)+      +      return ecsg3d++    removeEntity ecsg3d entity = do+      lacRemove entity (receivers ecsg3d)+      +      lacRemove entity (figures ecsg3d)+      lacRemove entity (posfig ecsg3d)+      lacRemove entity (orifig ecsg3d)+      +      lacRemove entity (cameras ecsg3d)+      lacRemove entity (poscam ecsg3d)+      lacRemove entity (oricam ecsg3d)+      +      lacRemove entity (lights ecsg3d)+      lacRemove entity (poslig ecsg3d)+      lacRemove entity (orilig ecsg3d)+      +      lacRemove entity (guiforms ecsg3d)+      lacRemove entity (scenepars ecsg3d)+      return ecsg3d+    +    initializeSystem = do+      g3d <- E.initHGamer3D "HGamer3D - System" True True True+      let (g3ds, guis, gtime) = g3d+      Gr.setAmbientLight g3ds D.white++      recv <- lacInitialize CTEvR+      +      figs <- lacInitialize CTFig+      posfig <- lacInitialize CTPos+      orifig <- lacInitialize CTOri++      cams <- lacInitialize CTCam+      poscam <- lacInitialize CTPos+      oricam <- lacInitialize CTOri+        +      ligs <- lacInitialize CTLig+      poslig <- lacInitialize CTPos+      orilig <- lacInitialize CTOri++      gfos <- lacInitialize CTGFo+      scpars <- lacInitialize CTScP++      mgt <- newIORef gtime++      return $ (ECSGraphics3D (g3ds, guis) recv figs posfig orifig cams poscam oricam ligs poslig orilig gfos scpars mgt)++    stepSystem ecsg3d = do+      let (g3ds, guis) = (g3d ecsg3d)++      -- small helper functions+      let update' pos edata schema = D.positionTo edata pos +      let update'' pos edata schema = D.orientationTo edata pos+          +      -- receivers+      lacApplyChanges (receivers ecsg3d) (\s -> return ()) (\s e -> return ()) (\e -> return ()) lacHandleU2CEvents lacHandleC2UEvents+          +      -- figures+      lacApplyChanges (figures ecsg3d) (Gr.object3D g3ds) (Gr.update3D g3ds) (Gr.remove3D g3ds) lacHandleU2CEvents lacHandleC2UEvents+      lacApplyOtherChanges (posfig ecsg3d) (figures ecsg3d) update'+      lacApplyOtherChanges (orifig ecsg3d) (figures ecsg3d) update''++      -- cameras+      let handleU2CEvents evts cam = do+            mapM (\evt -> case evt of+                     (E.WindowEvt (WinEvt.EvtWindow _ _ WinEvt.SDL_WINDOWEVENT_SIZE_CHANGED x y)) -> Gr.cameraAdaptAspectRatio cam+                     _ -> return ()+                 ) evts+            return ()+      lacApplyChanges (cameras ecsg3d) (Gr.addCamera g3ds) (Gr.updateCamera g3ds) (Gr.removeCamera g3ds) handleU2CEvents lacHandleC2UEvents+      lacApplyOtherChanges (poscam ecsg3d) (cameras ecsg3d) update'+      lacApplyOtherChanges (oricam ecsg3d) (cameras ecsg3d) update''+      +      -- lights+      lacApplyChanges (lights ecsg3d) (Gr.addLight g3ds) (Gr.updateLight g3ds) (Gr.removeLight g3ds) lacHandleU2CEvents lacHandleC2UEvents+      lacApplyOtherChanges (poslig ecsg3d) (lights ecsg3d) update'+      lacApplyOtherChanges (orilig ecsg3d) (lights ecsg3d) update''++      -- gui forms+      newFormEvents <- newIORef []+      let handleU2CEvents evts form = do+            mapM (\evt -> case evt of+                     (E.FormEvt (E.FormSetValue values)) -> GU.setFormValues form values+                     (E.GUIEvt (GU.GUIEvent tag sender window)) -> do+                       values <- GU.getFormValues form+                       strType <- GU.typeOfGuiEl window >>= return . last . (splitOn "/")+                       if tag `elem` (map fst values) then do+                         -- check if button+                         let newEvt = if strType == "Button"+                                        then E.FormEvt (E.FormButtonClick tag)+                                        else E.FormEvt (E.FormValueChange tag values)+                         -- show for testing+                         modifyIORef newFormEvents (\oldList -> (newEvt : oldList))+                         return ()+                         else return ()+                     _ -> return ()+                 ) evts+            return ()+      lacApplyChanges (guiforms ecsg3d) (GU.createForm guis) (GU.updateForm guis) (GU.removeForm guis) handleU2CEvents lacHandleC2UEvents+      +      -- scene parameters+      let updateScene eng new = Gr.setSceneParameter g3ds new+      let removeScene eng = return ()+      lacApplyChanges (scenepars ecsg3d) (Gr.setSceneParameter g3ds) updateScene removeScene lacHandleU2CEvents lacHandleC2UEvents+      +      -- step graphics system+      t <- readIORef (gt ecsg3d)+      (evts, nt, qFlag) <- E.stepHGamer3D g3ds guis t+      writeIORef (gt ecsg3d) nt++      -- handover evts towards the event system+      inList <- readIORef (lacList (receivers ecsg3d))+      evts' <- readIORef newFormEvents+      mapM (\(eid, com) -> do+               _pushC2UEvents com evts+               _pushC2UEvents com evts'+	       if qFlag then+	       	  _pushC2UEvents com [Evt.AppEvt Evt.AppQuit]+		  else return ()+           ) inList++      +      -- send camera resize events, set gui size+      let camEvts = filter (\evt -> case evt of+                                            (E.WindowEvt (WinEvt.EvtWindow _ _ WinEvt.SDL_WINDOWEVENT_SIZE_CHANGED x y)) -> True+                                            _ -> False) evts+      if length camEvts > 0 then do+        camList <- readIORef (lacList (cameras ecsg3d))+        mapM (\cam -> _pushU2CEvents (snd cam) camEvts) camList+        mapM (\(E.WindowEvt (WinEvt.EvtWindow _ _ WinEvt.SDL_WINDOWEVENT_SIZE_CHANGED x y)) -> GU.notifyDisplaySizeChanged guis (fromIntegral x) (fromIntegral y)) camEvts+        else return [()]++      -- handle GUI events, create high level gui events, push GUI events to gfos+      let guiEvts = filterEventType [GUIEvents] evts+      gfoList <- readIORef (lacList (guiforms ecsg3d))+      mapM (\gfo -> _pushU2CEvents (snd gfo) guiEvts) gfoList++      +      return (ecsg3d, qFlag)+     ++    shutdownSystem ecsg3d = do+      let (g3ds, guis) = (g3d ecsg3d)+      E.freeHGamer3D g3ds guis+      return ()++runSystemGraphics3D :: D.GameTime -> IO ECSGraphics3D+runSystemGraphics3D sleepT = runSystem sleepT++
+ HGamer3D/Engine/Schema/EventChannel.hs view
@@ -0,0 +1,33 @@+{-# Language StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Engine/Schema/EventSender Module+--++-- | Schema for EventSender+module HGamer3D.Engine.Schema.EventChannel++where++import Data.Typeable+import qualified HGamer3D.Data as D++data EventChannel = EventChannel String+                   deriving (Eq, Show, Typeable)+
+ HGamer3D/Engine/Schema/EventReceiver.hs view
@@ -0,0 +1,42 @@+{-# Language StandaloneDeriving, DeriveDataTypeable #-}+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.althainz.de/HGamer3D.html+--+-- (c) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/Engine/Schema/EventReceiver Module+--++-- | Schema for EventReceiver+module HGamer3D.Engine.Schema.EventReceiver++where++import Data.Typeable+import qualified HGamer3D.Data as D++data EventReceiver = EventReceiver [EventType] deriving (Eq, Show, Typeable)+data EventType = ChannelEvents+               | AudioEvents+               | WinEvents +               | GUIEvents+               | FormEvents+               | JoystickEvents+               | UserEvents+	       | ApplicationEvents+               | AllEvents+               deriving (Eq, Show, Typeable)+
+ HGamer3D/GUI/EcsAPI.hs view
@@ -0,0 +1,37 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Graphics.hs++-- | GUI for HGamer3D, ECS public API.+module HGamer3D.GUI.EcsAPI++(+	module HGamer3D.GUI.Schema.Form,+	module HGamer3D.GUI.Schema.GUIDim,+	module HGamer3D.GUI.Schema.Layout,+	module HGamer3D.GUI.Schema.Widget+)++where++import HGamer3D.GUI.Schema.Form+import HGamer3D.GUI.Schema.GUIDim+import HGamer3D.GUI.Schema.Layout+import HGamer3D.GUI.Schema.Widget+import HGamer3D.Internal.GUI
+ HGamer3D/Graphics3D/EcsAPI.hs view
@@ -0,0 +1,48 @@+-- This source file is part of HGamer3D+-- (A project to enable 3D game development in Haskell)+-- For the latest info, see http://www.hgamer3d.org+--+-- (c) 2011-2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- Graphics.hs++-- | 3D Graphics for HGamer3D, ECS public API.++module HGamer3D.Graphics3D.EcsAPI++(+  module HGamer3D.Graphics3D.Schema.Camera+  , module HGamer3D.Graphics3D.Schema.Figure+  , module HGamer3D.Graphics3D.Schema.Geometry+  , module HGamer3D.Graphics3D.Schema.Light+  , module HGamer3D.Graphics3D.Schema.Material+  , module HGamer3D.Graphics3D.Schema.Scene++  , ECSGraphics3D+  , runSystemGraphics3D+)++where++  import HGamer3D.Graphics3D.Schema.Camera+  import HGamer3D.Graphics3D.Schema.Figure+  import HGamer3D.Graphics3D.Schema.Geometry+  import HGamer3D.Graphics3D.Schema.Light+  import HGamer3D.Graphics3D.Schema.Material+  import HGamer3D.Graphics3D.Schema.Scene+  +  import HGamer3D.Engine.Internal.SystemGraphics3D++
+ HGamer3D/Internal/AudioModule.hs view
@@ -0,0 +1,28 @@+-- 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) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/AudioModule/EcsAPI+--++module HGamer3D.Internal.AudioModule++(+  module HGamer3D.Audio.Internal.SystemAudio+) where++import HGamer3D.Audio.Internal.SystemAudio
+ HGamer3D/Internal/Engine.hs view
@@ -0,0 +1,42 @@+-- 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) 2014 Peter Althainz+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++-- HGamer3D/AudioModule/EcsAPI+--++module HGamer3D.Internal.Engine++(+  module HGamer3D.Engine.Internal.Component,+  module HGamer3D.Engine.Internal.ComponentType,+  module HGamer3D.Engine.Internal.Entity,+  module HGamer3D.Engine.Internal.Event,+  module HGamer3D.Engine.Internal.GameLoop,+  module HGamer3D.Engine.Internal.System,+  module HGamer3D.Engine.Internal.SystemGraphics3D,+  module HGamer3D.Engine.Internal.SystemEvent+) where++import HGamer3D.Engine.Internal.Component+import HGamer3D.Engine.Internal.ComponentType+import HGamer3D.Engine.Internal.Entity+import HGamer3D.Engine.Internal.Event+import HGamer3D.Engine.Internal.GameLoop+import HGamer3D.Engine.Internal.System+import HGamer3D.Engine.Internal.SystemGraphics3D+import HGamer3D.Engine.Internal.SystemEvent