diff --git a/HGamer3D-Common.cabal b/HGamer3D-Common.cabal new file mode 100644 --- /dev/null +++ b/HGamer3D-Common.cabal @@ -0,0 +1,32 @@ +Name: HGamer3D-Common +Version: 0.5.0 +Synopsis: Toolset for the Haskell Game Programmer - Game Engine and Utilities +Description: + HGamer3D is a toolset for developing 3D games in the programming + language Haskell. HGamer3D is available on Windows and Linux. This + package provides common engine definitions and utility functions for HGamer3D. + +License: OtherLicense +License-file: LICENSE +Author: Peter Althainz +Maintainer: althainz@gmail.com +Build-Type: Simple +Cabal-Version: >=1.4 +Homepage: http://www.hgamer3d.org +Category: Game Engine +Extra-source-files: Setup.hs + +Library + Build-Depends: base >= 3 && < 5, HGamer3D-Data >= 0.5.0 && < 0.6.0, FindBin, directory, filepath, vect, clock, stm, containers + + Exposed-modules: HGamer3D.Common.FileLocation, HGamer3D.Common.UniqueName, HGamer3D.Common.ECS, HGamer3D.Common + Other-modules: + + c-sources: + + ghc-options: -O2 + cc-options: -Wno-attributes + hs-source-dirs: . + Include-dirs: . + build-depends: + extra-libraries: diff --git a/HGamer3D/Common.hs b/HGamer3D/Common.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Common.hs @@ -0,0 +1,36 @@ +-- 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 - 2013 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. +-- +-- ECS.hs +-- + +-- | Common Elements for HGamer3D +module HGamer3D.Common +( + module HGamer3D.Common.ECS, + module HGamer3D.Common.FileLocation, + module HGamer3D.Common.UniqueName +) + +where + +import HGamer3D.Common.ECS +import HGamer3D.Common.FileLocation +import HGamer3D.Common.UniqueName + + diff --git a/HGamer3D/Common/ECS.hs b/HGamer3D/Common/ECS.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Common/ECS.hs @@ -0,0 +1,326 @@ +{-# Language 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.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. + +-- | The Entity Component System for HGamer3D +module HGamer3D.Common.ECS +where + +import Data.Maybe +import Data.Dynamic +import Data.Typeable +import qualified Data.Map as M +import Data.IORef + +import Control.Concurrent +import Control.Concurrent.STM +import Control.Applicative + +import HGamer3D.Data + + +-- Components + +-- | Possible Components, which are known, this list needs to be extended, if +-- additional components are introduced. Each component can occur only once in +-- an Entity. +data Component = CTPos -- ^ Position + | CTOri -- ^ Orientation + | CTSiz -- ^ Size + | CTSca -- ^ Scale + | CTFig -- ^ Figure + | CTASr -- ^ Audio Source + | CTALs -- ^ Audio Listener + | CTCam -- ^ Camera + | CTLig -- ^ Light + | CTScP -- ^ Scene Parameter + | CTGFo -- ^ GUI Form + | CTWin -- ^ Window + | CTCmd -- ^ internal, used for sending commands, created automatically + | CTEvt -- ^ internal, used for receiving events, created automatically + deriving (Eq, Ord, Show) + +-- | Entities + +-- | Entity, Maps from Component to Dynamic +type Entity = M.Map Component Dynamic + +-- | Pair builder for nice construction syntax, allows [ ct #: val, ...] syntax +(#:) :: Typeable a => Component -> a -> (Component, Dynamic) +c #: val = (c, toDyn val) + +-- | Builder for entities, allows newE = entity [ct #: val, ...] syntax +entity :: [(Component, Dynamic)] -> Entity +entity clist = M.fromList clist + +-- | does the entity have the component +(#?) :: Entity -> Component -> Bool +e #? c = elem c $ M.keys e + +-- | get the component, throws exception, if component not present, or wrong type +(#) :: Typeable a => Entity -> Component -> a +e # c = fromJust $ M.lookup c e >>= fromDynamic + +-- | get the component as an maybe, in case wrong type +(?#) :: Typeable a => Entity -> Component -> Maybe a +e ?# c = M.lookup c e >>= fromDynamic + +-- | modification function, throws exception, if component not present +updateEntity :: Typeable a => Entity -> Component -> (a -> a) -> Entity +updateEntity e c f = M.insert c ((toDyn . f) (e # c)) e + +-- | modification function, sets entity component, needed for events +_setComponent :: Typeable a => Entity -> Component -> a -> Entity +_setComponent e c val = M.insert c (toDyn val) e + + +-- References to Entities + +-- besides Entity, we need atomic references to entities, we call them ERef +-- ERefs also have listeners for updates + +-- Listener Map, for each k, manages a map of writers, writers geting the old and the new value after a change + +type Listeners = TVar (M.Map Component [Entity -> Entity -> IO ()]) + +addListener :: Listeners -> Component -> (Entity -> Entity -> IO ()) -> IO () +addListener tls c l = atomically $ do + ls <- readTVar tls + let l' = case M.lookup c ls of + Just ol -> (l:ol) + Nothing -> [l] + writeTVar tls (M.insert c l' ls) + +clearAllListeners :: Listeners -> IO () +clearAllListeners tls = atomically $ do + ls <- readTVar tls + writeTVar tls (M.fromList []) + return () + +fireListeners :: Listeners -> Component -> Entity -> Entity -> IO () +fireListeners tls c val val' = do + ls <- atomically $ readTVar tls + case M.lookup c ls of + Just l -> mapM (\f -> f val val') l >> return () + Nothing -> return () + +-- ERef, composable objects, referenced Entities with listeners + +data ERef = ERef (TVar Entity) Listeners deriving (Eq) + +newE :: [(Component, Dynamic)] -> IO ERef +newE inlist = do + let e = entity (inlist ++ [CTCmd #: (), CTEvt #: ()]) + te <- newTVarIO e + tl <- newTVarIO (M.fromList []) + return $ ERef te tl + +readE :: ERef -> IO Entity +readE (ERef te _) = atomically $ readTVar te + +updateE :: Typeable a => ERef -> Component -> (a -> a) -> IO () +updateE (ERef te tl) c f = do + (val, val') <- atomically $ do + e <- readTVar te + let e' = updateEntity e c f + seq e' (writeTVar te e') + return (e, e') + fireListeners tl c val val' + return () + +_setE :: Typeable a => ERef -> Component -> a -> IO () +_setE (ERef te tl) c val = do + (eold, enew) <- atomically $ do + e <- readTVar te + let e' = _setComponent e c val + seq e' (writeTVar te e') + return (e, e') + fireListeners tl c eold enew + return () + +sendCmd :: Typeable a => ERef -> a -> IO () +sendCmd eref cmd = _setE eref CTCmd cmd + +sendEvt :: Typeable a => ERef -> a -> IO () +sendEvt eref cmd = _setE eref CTEvt cmd + +regEvtH :: Typeable a => ERef -> (a -> IO ()) -> IO () +regEvtH (ERef te tl) h = addListener tl CTEvt (\_ e' -> case (e' ?# CTEvt) of + Just val -> h val + Nothing -> return () ) + +-- ComponentListener + +-- | ComponentListener are tracking the change of a component of a specific entity. Ones this component changes, they contain the latest value of the entity. ComponentListener are implemented with the Listener mechanism for ERefs + +type ComponentListener = (TVar (Maybe (Entity, Entity))) + +componentListener :: ERef -> Component -> IO ComponentListener +componentListener er@(ERef te tl) c = do + tv <- newTVarIO Nothing + let w e e' = do + seq e (atomically $ writeTVar tv (Just (e, e'))) + return () + addListener tl c w + return tv + +queryComponentListener :: ComponentListener -> IO (Maybe (Entity, Entity)) +queryComponentListener tv = do + atomically $ do + v <- readTVar tv + writeTVar tv Nothing + return v + +-- System + +{- + A system reacts towards changes/updates in entities and their components. The system does it by creating for each component it handles an internal represenation, which it modifies upon changes to this component and to potentially additional changes in other components. For example an entity representing a light could have a Light component, which is created and modified upon change in the light component data. The entity may well have also a position component and the light entity is moved, in case the position component is modified. + + In general the system works by keeping a list of component listener on each added (each observes one component of an entity) and functions, which are called, in case the component listener exhibits a component change. + +-} + +type OnUpdateFunction = Entity -> Entity -> IO () +type OnDeleteFunction = IO () +type SystemRecord = (ComponentListener, OnUpdateFunction, OnDeleteFunction) +type SystemFunction a = a -> ERef -> IO [SystemRecord] + +data SystemData a = SystemData { + sdLock :: MVar (), + sdNewERefs :: IORef [ERef], + sdDelERefs :: IORef [ERef], + sdRecords :: [SystemRecord], + sdSystem :: a, + sdSystemFunction :: SystemFunction a +} + +class System a where + +-- to be implemented by instances + + initializeSystem :: IO (SystemData a) + stepSystem :: (SystemData a) -> IO Bool + +-- to be called from outside the runloop + + addERef :: (SystemData a) -> ERef -> IO () + addERef sd eref = do + let ref = sdNewERefs sd + let lock = sdLock sd + takeMVar lock + nrefs <- readIORef ref + writeIORef ref (eref : nrefs) + putMVar lock () + return () + + removeERef :: (SystemData a) -> ERef -> IO () + removeERef sd eref = do + let ref = sdDelERefs sd + let lock = sdLock sd + takeMVar lock + drefs <- readIORef ref + writeIORef ref (eref : drefs) + putMVar lock () + return () + + runSystem :: GameTime -> IO (SystemData 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' + + -- called within the run loop + + shutdownSystem :: (SystemData a) -> IO () + shutdownSystem system = return () + + stepSystem' :: (SystemData a) -> IO ((SystemData a), Bool) + stepSystem' sd@(SystemData lock nrefs drefs records system systemfunction) = do + -- add and delete erefs + takeMVar lock + adds <- readIORef nrefs + writeIORef nrefs [] + dels <- readIORef drefs + writeIORef drefs [] + putMVar lock () + + -- add new instances + newRecords <- mapM ((sdSystemFunction sd)(sdSystem sd)) adds + let records' = (concat newRecords) ++ records + + -- remove instances + -- to be done + let records'' = records' + + -- run stepfunction on tuples + let stepRecord (listener, updateF, deleteF) = do + me <- queryComponentListener listener + case me of + Just (e, e') -> updateF e e' + Nothing -> return () + mapM stepRecord records'' + + -- run specific stepSystem + let newSD = (SystemData lock nrefs drefs records'' system systemfunction) + qFlag <- stepSystem newSD + + -- return new values + return (newSD, qFlag) -- need to add quit condition here + + +-- management of systems +-- + +data SomeSystem = forall a . System a => SomeSystem (SystemData a) + +(#+) :: [SomeSystem] -> [SomeSystem] -> [SomeSystem] +vals #+ vals' = vals ++ vals' +infixr #+ + +-- ECS World functions, to manage entities in systems + +addToWorld :: [SomeSystem] -> ERef -> IO () +addToWorld systems e = mapM (f e) systems >> return () where + f e (SomeSystem sd) = addERef sd e >> return () + +removeFromWorld :: [SomeSystem] -> ERef -> IO () +removeFromWorld systems e = mapM (f e) systems >> return () where + f e (SomeSystem sd) = removeERef sd e >> return () + + + diff --git a/HGamer3D/Common/FileLocation.hs b/HGamer3D/Common/FileLocation.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Common/FileLocation.hs @@ -0,0 +1,92 @@ +-- 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-2013 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. + +-- Util.hs + +-- | Utility to provide file location information to other parts of HGamer3D +module HGamer3D.Common.FileLocation + +( + + -- * Directories relative to the user-related application directory for HGamer3D + getAppMediaDirectory, + getAppConfigDirectory, + getAppLibDirectory, + + -- * Directories relative to the executable (prog path) + -- getExeMediaDirectory, + -- getExeConfigDirectory, + -- getExeLibDirectory, + + -- * General utilities for path handling and finding files + osSep, + createDir, + findFileInDirs +) + +where + +import Control.Monad +import Control.Exception +import System.Directory +import System.FilePath +import System.Environment.FindBin + +_getHG3DDirectory subdir = do + appdir <- getAppUserDataDirectory "HGamer3D" + let ndir = appdir ++ [pathSeparator] ++ subdir + createDirectoryIfMissing True ndir + return ndir + +-- | path of media, relative to user app dir for HGamer3D +getAppMediaDirectory = _getHG3DDirectory "media" + +-- | path of configuration, relative to user app dir for HGamer3D +getAppConfigDirectory = _getHG3DDirectory "config" + +-- | path of libraries, relative to user app dir for HGamer3D +getAppLibDirectory = _getHG3DDirectory "lib" + +_getBinDir subdir = do + bdir <- try getProgPath :: IO (Either SomeException FilePath) + let bdir' = case bdir of + Left _ -> "." + Right path -> path + let ndir = bdir' ++ [pathSeparator] ++ ".HGamer3D" ++ [pathSeparator] ++ subdir + return ndir + +-- | path of media, relative to executable +getExeMediaDirectory = _getBinDir "media" + +-- | path of configuration, relative to executable +getExeConfigDirectory = _getBinDir "config" + +-- | path of libraries, relative to executable +getExeLibDirectory = _getBinDir "lib" + +-- | path separator for the filesystem +osSep = [pathSeparator] + +-- | create a directory +createDir dir = createDirectoryIfMissing True dir + +-- | find a file by searching in multiple directories +findFileInDirs filename listOfDirs = do + let files = fmap (\d -> d ++ [pathSeparator] ++ filename) listOfDirs + res <- filterM doesFileExist files + if length res > 0 then return $ Just (res !! 0) else return Nothing diff --git a/HGamer3D/Common/UniqueName.hs b/HGamer3D/Common/UniqueName.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Common/UniqueName.hs @@ -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-2013 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. + +-- UniqueName.hs + +-- | Utility to provide a unique name, carries internal state in a IORef +module HGamer3D.Common.UniqueName +( + + UniqueName, + createUniqueName, + nextUniqueName + +) where + +import Data.IORef + +data UniqueName = UniqueName String (IORef [Int]) + +-- | creates a unique name holder +createUniqueName :: String -> IO UniqueName +createUniqueName baseName = do + ref <- newIORef [0..] + return $ UniqueName baseName ref + +-- | delivers the next unique name from the name holder +nextUniqueName :: UniqueName -> IO String +nextUniqueName (UniqueName baseName ref) = do + name <- atomicModifyIORef ref (\ilist -> (tail ilist, baseName ++ (show (head ilist)))) + return name + + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,34 @@ +LICENSE +------- + +(c) 2011-2014 Peter Althainz + + +HGamer3D (http://www.hgamer3d.org) +---------------------------------- + +HGamer3D is licensed under the Apache License, Version 2.0 (the "License"); you may not use this software 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. + + +Source Code +----------- +You can obtain the latest version of the source code under http://www.bitbucket.org/althainz/HGamer3D + + +Open Source Software Used - Module HGamer3D.Data +------------------------------------------------ + +HGamer3D uses a number of open source software libraries. You are responsible to comply to the licenses of those packages and the licenses of software used by those packages if you use HGamer3D. + +The HGamer3D.Data module uses the following Haskell libraries from Hackage: + +base, license: BSD3 +FindBin, license: BSD3 +directory, license: BSD3 +filepath, license: BSD3 +vect, license: license: BSD3 + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,22 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.hgamer3d.org +-- +-- (c) 2011-2013 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Setup.hs + +import Distribution.Simple +main = defaultMain