HGamer3D-Wire-0.3.0: HGamer3D/Wire.hs

{-# LANGUAGE Arrows #-}

-- Some useful wires for game programming
--
-- (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.


module HGamer3D.Wire (
  
  module HGamer3D.Wire.Types,
  module HGamer3D.Wire.EntityComponentSystem,
  module HGamer3D.Wire.ECSWire,
  module HGamer3D.Wire.GUI,
  
  HGamer3D.Wire.loopHGamer3D,
  HGamer3D.Wire.initHGamer3D,
  HGamer3D.Wire.exitHGamer3D
  
  ) where

import Control.Wire as W
import Control.Wire.Unsafe.Event as U

import Prelude hiding ((.), id)

import HGamer3D
import HGamer3D.Audio
import HGamer3D.InputSystem
import HGamer3D.WinEvent hiding (initHGamer3D, loopHGamer3D, exitHGamer3D)
import HGamer3D.GUI 

import Control.Monad.Trans.Maybe

import HGamer3D.Wire.Types
import HGamer3D.Wire.EntityComponentSystem
import HGamer3D.Wire.ECSWire
import HGamer3D.Wire.GUI
  
import Data.IORef
import qualified Data.Map as M
import Data.Maybe



-- event register mechanism

-- init

initHGamer3D :: String -- ^ Window Title
                  -> Bool -- ^ Flag show config dialogue
                  -> Bool -- ^ Flag logging enabled
                  -> Bool -- ^ show Graphics Cursor
                  -> IO (WireSystem, Camera, Viewport)
initHGamer3D windowTitle fConfigDialogue fLog fGraphicsCursor = do
  (g3ds, guis, camera, viewport) <- HGamer3D.initHGamer3D windowTitle fConfigDialogue fLog fGraphicsCursor
  un <- createUniqueName "wire"
  gedm <- newIORef (M.fromList [])
  wedm <- newIORef []
  widgetListRef <- newIORef []
  let evtDistMap = (gedm, wedm) 
  let ws = WireSystem un g3ds guis evtDistMap widgetListRef
  return (ws, camera, viewport)
  
-- loop

loopHGamer3D :: WireSystem -> IO Bool
loopHGamer3D ws = do
  let g3ds = wsG3d ws
  let guis = wsGui ws       
  let (gedm, wedm) = wsEvtDistMap ws
  (mevt, qFlag) <- HGamer3D.loopHGamer3D g3ds guis
  qFlag' <- case mevt of
        Just (EventWindow sdle) -> do
          fm <- readIORef wedm
          mapM (\fwin -> fwin sdle) fm
          case sdle of
            (EvtQuit _) -> return True
            _ -> return False
        Just (EventGUI gevts) -> do
          mapM (\gevt@(GUIEvent tag _ _) -> do
                   fm <- readIORef gedm
                   let f = fromJust (M.lookup tag fm) 
                   f gevt
                   return ()) gevts
          return False
        _ -> return False
      
  return (qFlag || qFlag') 

-- exit

exitHGamer3D = HGamer3D.exitHGamer3D