HGamer3D-0.7.0: HGamer3D.hs

-- 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 - 2015 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, to include API
module HGamer3D

(
	module Fresco,
	module HGamer3D.Data,
	module HGamer3D.Util,
	module HGamer3D.Graphics3D,
	module HGamer3D.Input,
    module HGamer3D.GUI,
    module HGamer3D.Audio,

    configureHG3D,
    stepHG3D,
    loopHG3D,
    registerCallback,
    isExitHG3D,
    exitHG3D,

    HG3D,
)

where

import Fresco
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

-- run loop

type HG3D = (Entity, CallbackSystem, Var Bool)

configureHG3D = do

	cbsRef <- newEmptyMVar

	-- create graphics system
	eG3D <- newE [
	    ctGraphics3DConfig #: standardGraphics3DConfig,
	    ctGraphics3DCommand #: NoCmd
	    ]

	eih <- newE [
	    ctInputEventHandler #: DefaultEventHandler,
	    ctExitRequestedEvent #: ExitRequestedEvent
	    ]

	varExit <- makeVar False

	-- create callback loop
	forkIO $ do
	    cbs <- createCBS
	    registerCallback (eG3D, cbs, varExit) eih ctExitRequestedEvent (\_ -> writeVar varExit True >> return ())
	    putMVar cbsRef cbs
	    forever (stepCBS cbs)

	cbs <- takeMVar cbsRef

	return (eG3D, cbs, varExit)

stepHG3D (eG3D, cbs, varExit) = do
    setC eG3D ctGraphics3DCommand Step

isExitHG3D (eG3D, cbs, varExit) = do
	ise <- readVar varExit
	return ise

resetExitHG3D (eG3D, cbs, varExit) = writeVar varExit False

loopHG3D hg3d loopSleepTime checkExit = do
	stepHG3D hg3d
	sleepFor loopSleepTime
	ise <- do
		ise' <- isExitHG3D hg3d
		if ise' then do
			resetExitHG3D hg3d
			checkExit
			else
				return False
	if not ise then do
		loopHG3D hg3d loopSleepTime checkExit
		return ()
		else
			return ()

exitHG3D (eG3D, cvs, varExit) = do
	writeVar varExit True >> return ()

registerCallback (eG3D, cbs, varExit) e ct f = do
	registerReceiverCBS cbs e ct f