diff --git a/HGamer3D.cabal b/HGamer3D.cabal --- a/HGamer3D.cabal +++ b/HGamer3D.cabal @@ -1,5 +1,5 @@ Name: HGamer3D -Version: 0.7.1 +Version: 0.8.0 Synopsis: Toolset for the Haskell Game Programmer Description: HGamer3D is a toolset for developing 3D games in the programming @@ -16,9 +16,9 @@ Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, containers, bytestring, text, filepath, directory, vect >=0.4 && <0.5, messagepack >=0.5 && <0.6, clock >=0.6 && <0.7, cereal >=0.5 && < 0.6, fresco-binding >= 0.1.0 && < 0.2.0 + Build-Depends: base >= 3 && < 5, containers, bytestring, text, filepath, directory, vect >=0.4 && <0.5, messagepack >=0.5 && <0.6, clock >=0.6 && <0.7, cereal >=0.5 && < 0.6, fresco-binding >= 0.2.0 && < 0.3.0 - Exposed-modules: HGamer3D.Data.Angle, HGamer3D.Data.Colour, HGamer3D.Data.LMH, HGamer3D.Data.GameTime, HGamer3D.Data.Geometry2D, HGamer3D.Data.Transform3D, HGamer3D.Data.TypeSynonyms, HGamer3D.Data.Vector, HGamer3D.Data.Window, HGamer3D.Data.PlayCmd, HGamer3D.Data, HGamer3D.Util.FileLocation, HGamer3D.Util.UniqueName, HGamer3D.Util.Variable, HGamer3D.Util, HGamer3D.Graphics3D.Camera, HGamer3D.Graphics3D.Graphics3DCommand, HGamer3D.Graphics3D.Geometry, HGamer3D.Graphics3D.Graphics3DConfig, HGamer3D.Graphics3D.Light, HGamer3D.Graphics3D.Material, HGamer3D.Graphics3D.Window, HGamer3D.Input.Mouse, HGamer3D.Input.Keyboard, HGamer3D.Input.Joystick, HGamer3D.Input.InputEventHandler, HGamer3D.Input, HGamer3D.Graphics3D, HGamer3D.GUI.Button, HGamer3D.GUI.EditText, HGamer3D.GUI.DropDownList, HGamer3D.GUI.Slider, HGamer3D.GUI.Text, HGamer3D.GUI.CheckBox, HGamer3D.GUI, HGamer3D.Audio.SoundSource, HGamer3D.Audio.SoundListener, HGamer3D.Audio.Volume, HGamer3D.Audio, HGamer3D + Exposed-modules: HGamer3D.Data.Angle, HGamer3D.Data.Colour, HGamer3D.Data.LMH, HGamer3D.Data.GameTime, HGamer3D.Data.Geometry2D, HGamer3D.Data.Transform3D, HGamer3D.Data.TypeSynonyms, HGamer3D.Data.Vector, HGamer3D.Data.Window, HGamer3D.Data.PlayCmd, HGamer3D.Data.Parent, HGamer3D.Data, HGamer3D.Util.FileLocation, HGamer3D.Util.UniqueName, HGamer3D.Util.Variable, HGamer3D.Util, HGamer3D.Graphics3D.Camera, HGamer3D.Graphics3D.Graphics3DCommand, HGamer3D.Graphics3D.Geometry, HGamer3D.Graphics3D.Graphics3DConfig, HGamer3D.Graphics3D.Light, HGamer3D.Graphics3D.Material, HGamer3D.Graphics3D.Window, HGamer3D.Input.Mouse, HGamer3D.Input.Keyboard, HGamer3D.Input.Joystick, HGamer3D.Input.InputEventHandler, HGamer3D.Input, HGamer3D.Graphics3D, HGamer3D.GUI.UIElement, HGamer3D.GUI.Button, HGamer3D.GUI.EditText, HGamer3D.GUI.DropDownList, HGamer3D.GUI.Slider, HGamer3D.GUI.Text, HGamer3D.GUI.CheckBox, HGamer3D.GUI, HGamer3D.Audio.SoundSource, HGamer3D.Audio.SoundListener, HGamer3D.Audio.Volume, HGamer3D.Audio, HGamer3D Other-modules: diff --git a/HGamer3D.hs b/HGamer3D.hs --- a/HGamer3D.hs +++ b/HGamer3D.hs @@ -23,27 +23,40 @@ module HGamer3D ( - module Fresco, - module HGamer3D.Data, - module HGamer3D.Util, - module HGamer3D.Graphics3D, - module HGamer3D.Input, + module Fresco, + module HGamer3D.Data, + module HGamer3D.Util, + module HGamer3D.Graphics3D, + module HGamer3D.Input, module HGamer3D.GUI, module HGamer3D.Audio, - configureHG3D, - stepHG3D, - loopHG3D, + HG3D, + GameLogicFunction, + runGame, + registerCallback, isExitHG3D, + resetExitHG3D, exitHG3D, + newE, - HG3D, +-- ctParent, + EntityTree (..), + newET, + + (<:), + (<|), + (-:), + (-|), + + (#) ) where -import Fresco +import Fresco hiding (newE) +import qualified Fresco as F (newE) import HGamer3D.Data import HGamer3D.Util import HGamer3D.Graphics3D @@ -56,65 +69,127 @@ import Control.Concurrent.MVar import Data.IORef --- run loop +import qualified Data.Map as M +import Data.Word +import Data.Maybe -type HG3D = (Entity, CallbackSystem, Var Bool) +-- Opaque Value to denote some game-loop data +data HG3D = HG3D ObjectLibSystem CallbackSystem (Var Bool) -configureHG3D = do +-- runHG3D runs the engine in the main loop (for Mac) and executes game logic +type GameLogicFunction = HG3D -> IO () - cbsRef <- newEmptyMVar +-- runGame, runs the game in the main loop, creates threads for GameLogicFunctions +runGame :: Graphics3DConfig -> GameLogicFunction -> GameTime -> IO () +runGame conf glf loopSleepTime = do - -- create graphics system - eG3D <- newE [ - ctGraphics3DConfig #: standardGraphics3DConfig, - ctGraphics3DCommand #: NoCmd - ] + ols <- createOLS + cbs <- createCBS + varExit <- makeVar False - eih <- newE [ - ctInputEventHandler #: DefaultEventHandler, - ctExitRequestedEvent #: ExitRequestedEvent - ] + let hg3d = HG3D ols cbs varExit - varExit <- makeVar False + forkIO $ do - -- create callback loop - forkIO $ do - cbs <- createCBS - registerCallback (eG3D, cbs, varExit) eih ctExitRequestedEvent (\_ -> writeVar varExit True >> return ()) - putMVar cbsRef cbs - forever (stepCBS cbs) + -- create graphics system + eG3D <- newE hg3d [ + ctGraphics3DConfig #: conf, + ctGraphics3DCommand #: NoCmd + ] - cbs <- takeMVar cbsRef + eih <- newE hg3d [ + ctInputEventHandler #: DefaultEventHandler, + ctExitRequestedEvent #: ExitRequestedEvent + ] - return (eG3D, cbs, varExit) + -- create callback loop, handle windows exit command + forkIO $ do + registerReceiverCBS cbs eih ctExitRequestedEvent (\_ -> writeVar varExit True >> return ()) + forever $ (stepCBS cbs) -stepHG3D (eG3D, cbs, varExit) = do - setC eG3D ctGraphics3DCommand Step + -- create game logic loop + forkIO $ glf hg3d -isExitHG3D (eG3D, cbs, varExit) = do - ise <- readVar varExit - return ise + -- create game step loop + let gameStep = do + setC eG3D ctGraphics3DCommand Step + sleepFor loopSleepTime + gameStep -resetExitHG3D (eG3D, cbs, varExit) = writeVar varExit False + forkIO $ gameStep -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 () + return () -exitHG3D (eG3D, cvs, varExit) = do - writeVar varExit True >> return () + -- enter into endless game loop + let loopGame = do + stepOLS ols + ex <- readVar varExit + if ex + then return () + else loopGame -registerCallback (eG3D, cbs, varExit) e ct f = do - registerReceiverCBS cbs e ct f + 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 diff --git a/HGamer3D/Data.hs b/HGamer3D/Data.hs --- a/HGamer3D/Data.hs +++ b/HGamer3D/Data.hs @@ -37,6 +37,7 @@ -- * Misc module HGamer3D.Data.PlayCmd, + module HGamer3D.Data.Parent, -- * Implementation module HGamer3D.Data.Window @@ -54,4 +55,5 @@ import HGamer3D.Data.Vector import HGamer3D.Data.Window import HGamer3D.Data.PlayCmd +import HGamer3D.Data.Parent diff --git a/HGamer3D/Data/Geometry2D.hs b/HGamer3D/Data/Geometry2D.hs --- a/HGamer3D/Data/Geometry2D.hs +++ b/HGamer3D/Data/Geometry2D.hs @@ -10,7 +10,7 @@ file: HGamer3D/Data/Geometry2D.hs -} -{-# LANGUAGE FlexibleInstances, DatatypeContexts #-} +{-# LANGUAGE FlexibleInstances #-} -- | Type definitions for 2D geometry module HGamer3D.Data.Geometry2D diff --git a/HGamer3D/Data/Parent.hs b/HGamer3D/Data/Parent.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/Data/Parent.hs @@ -0,0 +1,31 @@ +{- + Datatypes to specify a parent by id + HGamer3D Library (A project to enable 3D game development in Haskell) + Copyright 2011-2015 Peter Althainz + + Distributed under the Apache License, Version 2.0 + (See attached file LICENSE or copy at + http://www.apache.org/licenses/LICENSE-2.0) + + file: HGamer3D/Data/Colour.hs +-} + +-- | The Parent component type +module HGamer3D.Data.Parent + +( + Parent, + ctParent +) + +where + +import Data.MessagePack +import Data.ByteString +import Fresco + +type Parent = ByteString + +ctParent :: ComponentType Parent +ctParent = ComponentType 0xbadd24df00e737d8 + diff --git a/HGamer3D/Data/TypeSynonyms.hs b/HGamer3D/Data/TypeSynonyms.hs --- a/HGamer3D/Data/TypeSynonyms.hs +++ b/HGamer3D/Data/TypeSynonyms.hs @@ -34,10 +34,10 @@ ctScale :: ComponentType Scale ctScale = ComponentType 0x2f9c124bc8fd41c4 --- CH4-3s +-- HGamer3D website, entities and events, example ComponentType ctOrientation :: ComponentType Orientation ctOrientation = ComponentType 0x815eb4d9c7bfaa74 --- CH4-3e +-- end of website text ctVisible :: ComponentType Bool ctVisible = ComponentType 0x98e7a78e949e1c6e diff --git a/HGamer3D/GUI.hs b/HGamer3D/GUI.hs --- a/HGamer3D/GUI.hs +++ b/HGamer3D/GUI.hs @@ -22,8 +22,10 @@ , module HGamer3D.GUI.CheckBox ) + where +import HGamer3D.GUI.UIElement import HGamer3D.GUI.Button import HGamer3D.GUI.EditText import HGamer3D.GUI.Text diff --git a/HGamer3D/GUI/Button.hs b/HGamer3D/GUI/Button.hs --- a/HGamer3D/GUI/Button.hs +++ b/HGamer3D/GUI/Button.hs @@ -10,9 +10,10 @@ file: HGamer3D/GUI/Button.hs -} --- | Module providing the Mouse functionality and settings +-- | Module providing the Button functionality and settings module HGamer3D.GUI.Button ( + Button (..), ctButton ) @@ -21,10 +22,20 @@ import Fresco import Debug.Trace import Data.Text +import Data.MessagePack import HGamer3D.Data -ctButton :: ComponentType Bool -ctButton = ComponentType 0x68a1857c27690b30 - + +data Button = Button { + buttonPressed::Bool, + buttonLabel::Text +} deriving (Eq, Show, Read) + +instance ComponentClass Button where + toObj (Button v1 v2) = ObjectArray [ObjectBool v1, (toObj v2)] + fromObj (ObjectArray [ObjectBool v1, v2]) = Button v1 (fromObj v2) + +ctButton :: ComponentType Button +ctButton = ComponentType 0x68a1857c27690b30 diff --git a/HGamer3D/GUI/UIElement.hs b/HGamer3D/GUI/UIElement.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/GUI/UIElement.hs @@ -0,0 +1,31 @@ +{- + GUI: Button functionality + HGamer3D Library (A project to enable 3D game development in Haskell) + Copyright 2015 Peter Althainz + + Distributed under the Apache License, Version 2.0 + (See attached file LICENSE or copy at + http://www.apache.org/licenses/LICENSE-2.0) + + file: HGamer3D/GUI/Button.hs +-} + +-- | Module providing the Button functionality and settings +module HGamer3D.GUI.UIElement +( + ctUIElement +) + +where + +import Fresco +import Debug.Trace +import Data.Text +import Data.MessagePack + +import HGamer3D.Data + +ctUIElement :: ComponentType () +ctUIElement = ComponentType 0xd5b79f5837e52274; + + diff --git a/HGamer3D/Graphics3D/Geometry.hs b/HGamer3D/Graphics3D/Geometry.hs --- a/HGamer3D/Graphics3D/Geometry.hs +++ b/HGamer3D/Graphics3D/Geometry.hs @@ -24,7 +24,8 @@ ( Shape (..), Geometry (..), - ctGeometry + ctGeometry, + ctGraphicsElement ) where @@ -39,9 +40,8 @@ -- generated --- CH4-4s +-- HGamer3D website, entities and events, Geometry data type and component -- | A shape is a basic geometric formd - data Shape = Sphere | Cube | Plane @@ -77,6 +77,7 @@ ctGeometry :: ComponentType Geometry ctGeometry = ComponentType 0xee433d1a4b964591 --- CH4-4e +ctGraphicsElement :: ComponentType () +ctGraphicsElement = ComponentType 0x65114ba821671643 +-- end of website text --- generated diff --git a/HGamer3D/Graphics3D/Graphics3DConfig.hs b/HGamer3D/Graphics3D/Graphics3DConfig.hs --- a/HGamer3D/Graphics3D/Graphics3DConfig.hs +++ b/HGamer3D/Graphics3D/Graphics3DConfig.hs @@ -122,3 +122,5 @@ ctGraphics3DConfig = ComponentType 0x0884eb62b6674bff + + diff --git a/HGamer3D/Graphics3D/Light.hs b/HGamer3D/Graphics3D/Light.hs --- a/HGamer3D/Graphics3D/Light.hs +++ b/HGamer3D/Graphics3D/Light.hs @@ -40,10 +40,10 @@ data Light = Light - LightType -- ^ Type of light - Float -- ^ brighness - Float -- ^ range - Float -- ^ specular intensity + LightType + Float + Float + Float -- ^ floats: brightness, range, specular intensity instance ComponentClass Light where toObj (Light lt b r s) = ObjectArray [toObj lt, ObjectFloat b, ObjectFloat r, ObjectFloat s] diff --git a/HGamer3D/Util.hs b/HGamer3D/Util.hs --- a/HGamer3D/Util.hs +++ b/HGamer3D/Util.hs @@ -23,9 +23,9 @@ module HGamer3D.Util ( - module HGamer3D.Util.FileLocation, - module HGamer3D.Util.UniqueName, - module HGamer3D.Util.Variable + module HGamer3D.Util.FileLocation, + module HGamer3D.Util.UniqueName, + module HGamer3D.Util.Variable ) where