module HGamer3D
(
module Fresco,
module HGamer3D.Data,
module HGamer3D.Util,
module HGamer3D.Graphics3D,
module HGamer3D.Input,
module HGamer3D.GUI,
module HGamer3D.Audio,
HG3D,
GameLogicFunction,
runGame,
registerCallback,
isExitHG3D,
resetExitHG3D,
exitHG3D,
newE,
EntityTree (..),
newET,
(<:),
(<|),
(-:),
(-|),
(#)
)
where
import Fresco hiding (newE)
import qualified Fresco as F (newE)
import HGamer3D.Data
import HGamer3D.Util
import HGamer3D.Graphics3D
import HGamer3D.Input
import HGamer3D.GUI
import HGamer3D.Audio
import Control.Concurrent
import Control.Monad
import Control.Concurrent.MVar
import Data.IORef
import qualified Data.Map as M
import Data.Word
import Data.Maybe
data HG3D = HG3D ObjectLibSystem CallbackSystem (Var Bool)
type GameLogicFunction = HG3D -> IO ()
runGame :: Graphics3DConfig -> GameLogicFunction -> GameTime -> IO ()
runGame conf glf loopSleepTime = do
ols <- createOLS
cbs <- createCBS
varExit <- makeVar False
let hg3d = HG3D ols cbs varExit
forkIO $ do
eG3D <- newE hg3d [
ctGraphics3DConfig #: conf,
ctGraphics3DCommand #: NoCmd
]
eih <- newE hg3d [
ctInputEventHandler #: DefaultEventHandler,
ctExitRequestedEvent #: ()
]
forkIO $ do
registerReceiverCBS cbs eih ctExitRequestedEvent (\_ -> writeVar varExit True >> return ())
forever $ (stepCBS cbs)
forkIO $ glf hg3d
let gameStep = do
setC eG3D ctGraphics3DCommand Step
sleepFor loopSleepTime
gameStep
forkIO $ gameStep
return ()
let loopGame = do
stepOLS ols
ex <- readVar varExit
if ex
then return ()
else loopGame
loopGame
isExitHG3D (HG3D ols cbs varExit) = do
ise <- readVar varExit
return ise
resetExitHG3D (HG3D ols cbs varExit) = writeVar varExit False
exitHG3D (HG3D ols cbs varExit) = do
writeVar varExit True >> return ()
registerCallback (HG3D ols cbs varExit) e ct f = do
registerReceiverCBS cbs e ct f
newE (HG3D ols cbs varExit) creationList = do
e <- F.newE creationList
addEntityOLS ols e
return e
data EntityTree = ETNode (Maybe String) [(Word64, Component)]
| ETChild (Maybe String) [(Word64, Component)] [EntityTree]
| ETList [EntityTree]
createET :: HG3D -> EntityTree -> Maybe Entity -> IO [(String, Entity)]
createET hg3d (ETNode label clist) parent = do
clist' <- case parent of
Just p -> idE p >>= \id -> return ((ctParent #: id) : filter (\(ct, c) -> (ComponentType ct) /= ctParent) clist)
Nothing -> return clist
e <- newE hg3d clist'
case label of
Just l -> return [(l, e)]
Nothing -> return []
createET hg3d (ETList tlist) parent = do
l <- mapM (\et -> createET hg3d et parent) tlist
return (Prelude.concat l)
createET hg3d (ETChild label clist tlist) parent = do
[(_, e1)] <- createET hg3d (ETNode (Just "label") clist) parent
let l1 = case label of
Just l -> [(l, e1)]
Nothing -> []
l2 <- createET hg3d (ETList tlist) (Just e1)
return (l1 ++ l2)
newET :: HG3D -> [EntityTree] -> IO (M.Map String Entity)
newET hg3d et = createET hg3d (ETList et) Nothing >>= \l -> return (M.fromList l)
(<:) :: String -> [(Word64, Component)] -> EntityTree
label <: clist = ETNode (Just label) clist
(<|) :: String -> ([(Word64, Component)], [EntityTree]) -> EntityTree
label <| (clist, tlist) = ETChild (Just label) clist tlist
(-:) :: () -> [(Word64, Component)] -> EntityTree
() -: clist = ETNode Nothing clist
(-|) :: () -> ([(Word64, Component)], [EntityTree]) -> EntityTree
() -| (clist, tlist) = ETChild Nothing clist tlist
(#) :: (M.Map String Entity) -> String -> Entity
m # s = fromJust $ M.lookup s m