HGamer3D 0.6.1 → 0.6.2
raw patch · 28 files changed
+677/−195 lines, 28 files
Files
- HGamer3D.cabal +4/−4
- HGamer3D.hs +5/−1
- HGamer3D/Audio.hs +29/−0
- HGamer3D/Audio/SoundListener.hs +30/−0
- HGamer3D/Audio/SoundSource.hs +44/−0
- HGamer3D/Audio/Volume.hs +37/−0
- HGamer3D/Binding/CFunctions.chs.h +0/−3
- HGamer3D/Data.hs +4/−0
- HGamer3D/Data/Component.hs +10/−0
- HGamer3D/Data/Geometry2D.hs +16/−8
- HGamer3D/Data/PlayCmd.hs +40/−0
- HGamer3D/Data/TypeSynonyms.hs +2/−0
- HGamer3D/ECS/Entity.hs +45/−45
- HGamer3D/ECS/System.hs +27/−27
- HGamer3D/GUI.hs +34/−0
- HGamer3D/GUI/Button.hs +30/−0
- HGamer3D/GUI/CheckBox.hs +30/−0
- HGamer3D/GUI/DropDownList.hs +37/−0
- HGamer3D/GUI/EditText.hs +28/−0
- HGamer3D/GUI/Slider.hs +38/−0
- HGamer3D/GUI/Text.hs +30/−0
- HGamer3D/Graphics3D/Geometry.hs +11/−9
- HGamer3D/Graphics3D/SystemGraphics3D.hs +64/−36
- HGamer3D/Input.hs +3/−1
- HGamer3D/Input/InputEventHandler.hs +70/−0
- HGamer3D/Input/InputEvents.hs +0/−59
- HGamer3D/Input/Keyboard.hs +5/−1
- HGamer3D/Input/Mouse.hs +4/−1
HGamer3D.cabal view
@@ -1,5 +1,5 @@ Name: HGamer3D -Version: 0.6.1 +Version: 0.6.2 Synopsis: Toolset for the Haskell Game Programmer Description: HGamer3D is a toolset for developing 3D games in the programming @@ -18,7 +18,7 @@ Library Build-Depends: base >= 3 && < 5, containers, bytestring, text, filepath, directory, vect >=0.4 && <0.5, messagepack >=0.4 && <0.5, clock >=0.5 && <0.6, cereal >=0.4 && < 0.5 - Exposed-modules: HGamer3D.Binding.CFunctions, HGamer3D.Binding.Helper, HGamer3D.Binding, 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, HGamer3D.Util.FileLocation, HGamer3D.Util.UniqueName, HGamer3D.Util, HGamer3D.ECS.Entity, HGamer3D.Data.Component, HGamer3D.ECS.System, HGamer3D.ECS, 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, HGamer3D.Graphics3D.SystemGraphics3D, HGamer3D.Graphics3D, HGamer3D + Exposed-modules: HGamer3D.Binding.CFunctions, HGamer3D.Binding.Helper, HGamer3D.Binding, 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, HGamer3D.ECS.Entity, HGamer3D.Data.Component, HGamer3D.ECS.System, HGamer3D.ECS, 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.SystemGraphics3D, 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 Other-modules: @@ -30,7 +30,7 @@ Include-dirs: . build-depends: if os(windows) - extra-libraries: hgamer3d061 + extra-libraries: hgamer3d062 else - extra-libraries: hgamer3d061, Urho3D + extra-libraries: hgamer3d062, Urho3D
HGamer3D.hs view
@@ -27,7 +27,9 @@ module HGamer3D.Util, module HGamer3D.ECS, module HGamer3D.Graphics3D, - module HGamer3D.Input + module HGamer3D.Input, + module HGamer3D.GUI, + module HGamer3D.Audio ) where @@ -37,3 +39,5 @@ import HGamer3D.ECS import HGamer3D.Graphics3D import HGamer3D.Input +import HGamer3D.GUI +import HGamer3D.Audio
+ HGamer3D/Audio.hs view
@@ -0,0 +1,29 @@+{- + Sound and Music + 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/Audio.hs +-} + + +-- | Audio for HGamer3D +module HGamer3D.Audio + +( + module HGamer3D.Audio.SoundSource + , module HGamer3D.Audio.SoundListener + , module HGamer3D.Audio.Volume +) + +where + +import HGamer3D.Audio.SoundSource +import HGamer3D.Audio.SoundListener +import HGamer3D.Audio.Volume + +
+ HGamer3D/Audio/SoundListener.hs view
@@ -0,0 +1,30 @@+{- + Audio: Listener for sound, specifies mainyl the position for 3D sound + 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/Audio/SoundListener.hs +-} + +-- | Sound Listener +module HGamer3D.Audio.SoundListener +( + ctSoundListener +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +ctSoundListener :: ComponentType () +ctSoundListener = ComponentType 0x7aacf4ee5bd2f958 + +
+ HGamer3D/Audio/SoundSource.hs view
@@ -0,0 +1,44 @@+{- + Sound Source + 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/Audio/SoundSource.hs +-} + +-- | Module providing a Sound Source +module HGamer3D.Audio.SoundSource +( + SoundSource (..), + ctSoundSource +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +data SoundSource = Sound Text Float Bool Text -- resource, Volume, loop, volume group + | Sound3D Text Float Bool Text + | Music Text Float Bool Text + deriving (Eq, Show) + +instance ComponentClass SoundSource where + toObj (Sound snd vol l g) = ObjectArray [ObjectInt 0, toObj snd, ObjectFloat vol, ObjectBool l, toObj g] + toObj (Sound3D snd vol l g) = ObjectArray [ObjectInt 1, toObj snd, ObjectFloat vol, ObjectBool l, toObj g] + toObj (Music snd vol l g) = ObjectArray [ObjectInt 2, toObj snd, ObjectFloat vol, ObjectBool l, toObj g] + fromObj (ObjectArray [ObjectInt 0, snd_o, ObjectFloat vol, ObjectBool l, g_o]) = Sound (fromObj snd_o) vol l (fromObj g_o) + fromObj (ObjectArray [ObjectInt 1, snd_o, ObjectFloat vol, ObjectBool l, g_o]) = Sound3D (fromObj snd_o) vol l (fromObj g_o) + fromObj (ObjectArray [ObjectInt 2, snd_o, ObjectFloat vol, ObjectBool l, g_o]) = Music (fromObj snd_o) vol l (fromObj g_o) + +ctSoundSource :: ComponentType SoundSource +ctSoundSource = ComponentType 0xafcef7aa41d88c0d + +
+ HGamer3D/Audio/Volume.hs view
@@ -0,0 +1,37 @@+{- + Audio: Master Volume for different categories + 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/Audio/Volume.hs +-} + +-- | Module providing the Mouse functionality and settings +module HGamer3D.Audio.Volume +( + Volume (..), + ctVolume +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +data Volume = Volume Text Float deriving (Eq, Show) + +instance ComponentClass Volume where + toObj (Volume cat vol) = ObjectArray [toObj cat, ObjectFloat vol] + fromObj (ObjectArray [cat_o, ObjectFloat vol]) = Volume (fromObj cat_o) vol + +ctVolume :: ComponentType Volume +ctVolume = ComponentType 0x659d20e6e65f85fe + +
− HGamer3D/Binding/CFunctions.chs.h
@@ -1,3 +0,0 @@-#define C2HS_MIN_VERSION(mj,mn,rv) ((mj)<=C2HS_VERSION_MAJOR && (mn)<=C2HS_VERSION_MINOR && (rv)<=C2HS_VERSION_REV) -#include "interface.h" -#include "interface.h"
HGamer3D/Data.hs view
@@ -35,6 +35,9 @@ module HGamer3D.Data.Transform3D, module HGamer3D.Data.TypeSynonyms, + -- * Misc + module HGamer3D.Data.PlayCmd, + -- * Entity Component System, Index Type module HGamer3D.Data.Component, @@ -54,4 +57,5 @@ import HGamer3D.Data.Vector import HGamer3D.Data.Window import HGamer3D.Data.Component +import HGamer3D.Data.PlayCmd
HGamer3D/Data/Component.hs view
@@ -53,5 +53,15 @@ instance ComponentClass Bool where toObj b = ObjectBool b fromObj (ObjectBool b) = b + +instance ComponentClass Int where + toObj i = ObjectInt (fromIntegral i) + fromObj (ObjectInt i) = fromIntegral i + +instance ComponentClass a => ComponentClass (Maybe a) where + toObj Nothing = ObjectArray [ObjectInt 0] + toObj (Just v) = ObjectArray [ObjectInt 1, toObj v] + fromObj (ObjectArray [ObjectInt 0]) = Nothing + fromObj (ObjectArray [ObjectInt 1, v_o]) = Just (fromObj v_o)
HGamer3D/Data/Geometry2D.hs view
@@ -18,6 +18,9 @@ -- * Geometry Point (..), Rectangle (..), + + ctScreenRect, + rectFromPoints, pointsFromRect @@ -42,11 +45,14 @@ -- | A rectangle has an a position as x and y and widht and height data Num a => Rectangle a = Rectangle { - rectX :: a, - rectY :: a, - rectWidth :: a, - rectHeight :: a } deriving (Eq, Show) + xpos :: a, + ypos :: a, + width :: a, + height :: a } deriving (Eq, Show) +ctScreenRect :: ComponentType (Rectangle Int) +ctScreenRect = ComponentType 0x16877957e32da6b1 + instance ComponentClass (Rectangle Float) where toObj (Rectangle x y w h) = ObjectArray [ObjectFloat x, ObjectFloat y, ObjectFloat w, ObjectFloat h] fromObj (ObjectArray [ObjectFloat x, ObjectFloat y, ObjectFloat w, ObjectFloat h]) = (Rectangle x y w h) @@ -55,6 +61,8 @@ toObj (Rectangle x y w h) = ObjectArray [ObjectInt (fromIntegral x), ObjectInt (fromIntegral y), ObjectInt (fromIntegral w), ObjectInt (fromIntegral h)] fromObj (ObjectArray [ObjectInt x, ObjectInt y, ObjectInt w, ObjectInt h]) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) + + -- | derive a rectangle from upper left and lower right points rectFromPoints :: Num a => Point a -> Point a -> Rectangle a rectFromPoints upperLeft lowerRight = Rectangle rx ry rw rh where @@ -66,10 +74,10 @@ -- | get upper left and lower right point from a rect pointsFromRect :: Num a => Rectangle a -> (Point a, Point a) pointsFromRect rect = (ul, lr) where - rx = rectX rect - ry = rectY rect - rx' = rx + (rectWidth rect) - ry' = ry + (rectHeight rect) + rx = xpos rect + ry = ypos rect + rx' = rx + (width rect) + ry' = ry + (height rect) ul = Point rx ry lr = Point rx' ry'
+ HGamer3D/Data/PlayCmd.hs view
@@ -0,0 +1,40 @@+{- + The Play Command + 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/PlayCmd.hs +-} + +-- | Type for a generic play command +module HGamer3D.Data.PlayCmd +( + PlayCmd (..), + ctPlayCmd + +) where + +import Data.MessagePack +import HGamer3D.Data.Component + +data PlayCmd = Play + | Pause + | Stop + deriving (Eq, Show) + +instance ComponentClass PlayCmd where + toObj Play = ObjectInt 1 + toObj Pause = ObjectInt 2 + toObj Stop = ObjectInt 3 + fromObj (ObjectInt 1) = Play + fromObj (ObjectInt 2) = Pause + fromObj (ObjectInt 3) = Stop + +ctPlayCmd :: ComponentType PlayCmd +ctPlayCmd = ComponentType 0x35f7752020f7f1cd + +
HGamer3D/Data/TypeSynonyms.hs view
@@ -34,8 +34,10 @@ ctScale :: ComponentType Scale ctScale = ComponentType 0x2f9c124bc8fd41c4 +-- CH4-3s ctOrientation :: ComponentType Orientation ctOrientation = ComponentType 0x815eb4d9c7bfaa74 +-- CH4-3e ctVisible :: ComponentType Bool ctVisible = ComponentType 0x98e7a78e949e1c6e
HGamer3D/ECS/Entity.hs view
@@ -23,21 +23,21 @@ -- | Entity of the Entity ComponentType System for HGamer3D module HGamer3D.ECS.Entity ( --- * Entity Data Type +-- * EntityData Type -- Entities are a kind of simplified extensible record system. They are basically a Map from ComponentType (64 bit id) to a data item with -- ComponentClass Typeclass. Basic entities are non-mutable but their exists the entity reference. - Entity, + EntityData, (#:), - (#?), + (#!), (#), --- * ERef Data Type --- The ERef type, which puts an Entity into +-- * Entity Type +-- The ERef type, which puts an EntityData into -- an IORef and serves as mutable data structure. -- In HGamer3D those ERefs are also used as thread-safe communication vehicle towards the C/C++ implementation of multimedia functionality. - ERef (..), + Entity (..), newE, readE, readC, @@ -70,36 +70,36 @@ import HGamer3D.Binding import HGamer3D.Data --- | Entity, a simple non-mutable record type, implemented as Map -type Entity = M.Map Word64 Component +-- | EntityData, a simple non-mutable record type, implemented as Map +type EntityData = M.Map Word64 Component -- | pair builder for nice construction syntax, allows [ ct #: val, ...] syntax (#:) :: ComponentClass a => ComponentType a -> a -> (Word64, Component) (ComponentType c) #: val = (c, toMsg val) -- | Builder for entities, allows newE = entity [ct #: val, ...] syntax -entity :: [(Word64, Component)] -> Entity -entity clist = M.fromList clist +entityData :: [(Word64, Component)] -> EntityData +entityData clist = M.fromList clist -- | does the entity have the ComponentType -(#?) :: Entity -> ComponentType a -> Bool +(#?) :: EntityData -> ComponentType a -> Bool e #? (ComponentType c) = Prelude.elem c $ M.keys e -- | get the ComponentType, throws exception, if ComponentType not present -(#) :: ComponentClass a => Entity -> ComponentType a -> a -e # (ComponentType c) = fromJust $ M.lookup c e >>= fromMsg +(#!) :: ComponentClass a => EntityData -> ComponentType a -> a +e #! (ComponentType c) = fromJust $ M.lookup c e >>= fromMsg -- | get the ComponentType as an maybe, in case wrong type -(?#) :: ComponentClass a => Entity -> ComponentType a -> Maybe a -e ?# (ComponentType c) = M.lookup c e >>= fromMsg +(#) :: ComponentClass a => EntityData -> ComponentType a -> Maybe a +e # (ComponentType c) = M.lookup c e >>= fromMsg -- | modification function, throws exception, if ComponentType not present -updateEntity :: ComponentClass a => Entity -> ComponentType a -> (a -> a) -> Entity -updateEntity e c'@(ComponentType c) f = M.insert c ((toMsg . f) (e # c')) e +updateDataC :: ComponentClass a => EntityData -> ComponentType a -> (a -> a) -> EntityData +updateDataC e c'@(ComponentType c) f = M.insert c ((toMsg . f) (e #! c')) e -- | modification function, sets entity ComponentType, needed for events -setComponentType :: ComponentClass a => Entity -> ComponentType a -> a -> Entity -setComponentType e (ComponentType c) val = M.insert c (toMsg val) e +setDataC :: ComponentClass a => EntityData -> ComponentType a -> a -> EntityData +setDataC e (ComponentType c) val = M.insert c (toMsg val) e -- References to Entities @@ -109,67 +109,67 @@ -- Listener Map, for each k, manages a map of writers, writers geting the old and the new value after a change -type Listeners = IORef (M.Map Word64 [Entity -> Entity -> IO ()]) +type Listeners = IORef (M.Map Word64 [EntityData -> EntityData -> IO ()]) -- | ERef, composable objects, referenced Entities with listeners -data ERef = ERef (IORef Entity) Listeners deriving (Eq) +data Entity = Entity (IORef EntityData) Listeners deriving (Eq) -- | Add an action (IO function), which will be executed when value of ComponentType is changed -addListener :: ERef -> ComponentType a -> (Entity -> Entity -> IO ()) -> IO () -addListener (ERef _ tls) (ComponentType c) l = atomicModifyIORef tls (\m -> let +addListener :: Entity -> ComponentType a -> (EntityData -> EntityData -> IO ()) -> IO () +addListener (Entity _ tls) (ComponentType c) l = atomicModifyIORef tls (\m -> let l' = case M.lookup c m of Just ol -> ol ++ [l] Nothing -> [l] in (M.insert c l' m, ())) --- | Clear all listeners from ERef -clearListeners :: ERef -> IO () -clearListeners (ERef _ tls) = atomicWriteIORef tls (M.fromList []) +-- | Clear all listeners from Entity +clearListeners :: Entity -> IO () +clearListeners (Entity _ tls) = atomicWriteIORef tls (M.fromList []) -fireListeners :: ERef -> ComponentType a -> Entity -> Entity -> IO () -fireListeners (ERef _ tls) (ComponentType c) val val' = do +fireListeners :: Entity -> ComponentType a -> EntityData -> EntityData -> IO () +fireListeners (Entity _ tls) (ComponentType c) val val' = do ls <- readIORef tls case M.lookup c ls of Just l -> mapM (\f -> f val val') l >> return () Nothing -> return () --- | creates an ERef -newE :: [(Word64, Component)] -> IO ERef +-- | creates an Entity +newE :: [(Word64, Component)] -> IO Entity newE inlist = do - let e = entity inlist + let e = entityData inlist te <- newIORef e tl <- newIORef (M.fromList []) - return $ ERef te tl + return $ Entity te tl --- | reads the Entity from an ERef -readE :: ERef -> IO Entity -readE (ERef te _) = readIORef te +-- | reads the EntityData from an Entity +readE :: Entity -> IO EntityData +readE (Entity te _) = readIORef te -- | reads one ComponentType, throws exception, if ComponentType not present, or wrong type -readC :: ComponentClass a => ERef -> ComponentType a -> IO a -readC er c = readE er >>= \e -> return (e # c) +readC :: ComponentClass a => Entity -> ComponentType a -> IO a +readC er c = readE er >>= \e -> return (e #! c) -- | updates one ComponentType -updateC :: ComponentClass a => ERef -> ComponentType a -> (a -> a) -> IO () -updateC er@(ERef te tl) c f = do +updateC :: ComponentClass a => Entity -> ComponentType a -> (a -> a) -> IO () +updateC er@(Entity te tl) c f = do (e, e') <- atomicModifyIORef te (\olde -> let - newe = updateEntity olde c f + newe = updateDataC olde c f in (newe, (olde, newe))) fireListeners er c e e' return () -- | sets one ComponentType -setC :: ComponentClass a => ERef -> ComponentType a -> a -> IO () -setC er@(ERef te tl) c val = do +setC :: ComponentClass a => Entity -> ComponentType a -> a -> IO () +setC er@(Entity te tl) c val = do (e, e') <- atomicModifyIORef te (\olde -> let - newe = setComponentType olde c val + newe = setDataC olde c val in (newe, (olde, newe))) fireListeners er c e e' return () -- | sets one ComponentType as Component -_setC' :: ERef -> Word64 -> Component -> IO () -_setC' er@(ERef te tls) c val = do +_setC' :: Entity -> Word64 -> Component -> IO () +_setC' er@(Entity te tls) c val = do (e, e') <- atomicModifyIORef te (\olde -> let newe = M.insert c val olde in (newe, (olde, newe)))
HGamer3D/ECS/System.hs view
@@ -58,10 +58,10 @@ -- ComponentListener, used internally in sytems -type ComponentListener = IORef (Maybe (Entity, Entity)) +type ComponentListener = IORef (Maybe (EntityData, EntityData)) -componentListener :: ERef -> ComponentType a -> IO ComponentListener -componentListener er@(ERef te tl) c = do +componentListener :: Entity -> ComponentType a -> IO ComponentListener +componentListener er@(Entity te tl) c = do tv <- newIORef Nothing let w e e' = atomicModifyIORef tv (\old -> let new = case old of @@ -71,7 +71,7 @@ addListener er c w return tv -queryComponentListener :: ComponentListener -> IO (Maybe (Entity, Entity)) +queryComponentListener :: ComponentListener -> IO (Maybe (EntityData, EntityData)) queryComponentListener tv = atomicModifyIORef tv (\val -> (Nothing, val)) @@ -82,16 +82,16 @@ -} -type OnUpdateFunction = Entity -> Entity -> IO () +type OnUpdateFunction = EntityData -> EntityData -> IO () type OnDeleteFunction = IO () -type SystemRecord = (ERef, Either (ComponentListener, OnUpdateFunction) OnDeleteFunction) -type SystemFunction = SystemData -> ERef -> IO [SystemRecord] +type SystemRecord = (Entity, Either (ComponentListener, OnUpdateFunction) OnDeleteFunction) +type SystemFunction = SystemData -> Entity -> IO [SystemRecord] -- | this data specifies the type of system data SystemData = SystemData { sdLock :: MVar (), - sdNewERefs :: IORef [ERef], - sdDelERefs :: IORef [ERef], + sdNewEntities :: IORef [Entity], + sdDelEntities :: IORef [Entity], sdRecords :: [SystemRecord], sdComponents :: [Word64], sdProperties :: [Word64], @@ -107,11 +107,11 @@ sdErrorMessage :: (Int) -> IO ((String)) } -addERef :: SystemData -> ERef -> IO () -addERef sd eref = atomicModifyIORef (sdNewERefs sd) (\a -> (eref : a, ())) +addEntity :: SystemData -> Entity -> IO () +addEntity sd entity = atomicModifyIORef (sdNewEntities sd) (\a -> (entity : a, ())) -removeERef :: SystemData -> ERef -> IO () -removeERef sd eref = atomicModifyIORef (sdDelERefs sd) (\a -> (eref : a, ())) +removeEntity :: SystemData -> Entity -> IO () +removeEntity sd entity = atomicModifyIORef (sdDelEntities sd) (\a -> (entity : a, ())) stepRecord (er, Left (listener, updateF)) = do me <- queryComponentListener listener @@ -126,7 +126,7 @@ stepSystem :: SystemData -> IO Bool -> IO (SystemData, Bool) stepSystem sd@(SystemData lock nrefs drefs records cs ps es ci di gm rm em) stepF = do - -- add and delete erefs + -- add and delete Entitys adds <- atomicModifyIORef nrefs (\a -> ([],a)) dels <- atomicModifyIORef drefs (\a -> ([],a)) @@ -177,7 +177,7 @@ -- called within the run loop -systemFunction sd eref = do +systemFunction sd entity = do let components = sdComponents sd let properties = sdProperties sd @@ -190,23 +190,23 @@ let errorMessage = sdErrorMessage sd let r = [] - e <- readE eref + e <- readE entity - -- create system records, (ERef, Either (Listener, UdateF) DeleteF) + -- create system records, (Entity, Either (Listener, UdateF) DeleteF) rs <- mapM (\c -> if c `elem` components then do (res, rep) <- createItem c (e M.! c) -- create the item if res == 0 - then do let ir = (eref, Right (destroyItem c rep >> return ())) + then do let ir = (entity, Right (destroyItem c rep >> return ())) -- add property records with listeners, also components can act as property prs <- mapM (\p -> if p `elem` (properties ++ components) then do (res', propF) <- getMessageSender c p if res' == 0 - then do lp <- componentListener eref (ComponentType p) + then do lp <- componentListener entity (ComponentType p) let uf = (\oe ne -> callMsgFunction propF rep (ne M.! p) >> return ()) uf e e -- call message function, update component with this property right away - return [(eref, Left (lp, uf) )] + return [(entity, Left (lp, uf) )] else return [] else return [] ) (M.keys e) @@ -216,7 +216,7 @@ -- add event writer, in case applicable mapM (\p -> if p `elem` events then do let fwrite = (\_ msgData msgLen -> do bData <- B.packCStringLen (msgData, fromIntegral msgLen) - _setC' eref p bData + _setC' entity p bData return 0) fwritePtr <- mkMsgFunPtr fwrite registerMessageReceiver c p rep fwritePtr @@ -241,13 +241,13 @@ -- management of systems -- --- | add an ERef to the world, thread safe -addToWorld :: [SystemData] -> ERef -> IO () -addToWorld systems e = mapM (\s -> addERef s e) systems >> return () +-- | add an Entity to the world, thread safe +addToWorld :: [SystemData] -> Entity -> IO () +addToWorld systems e = mapM (\s -> addEntity s e) systems >> return () --- | remove an ERef from the world, thread safe -removeFromWorld :: [SystemData] -> ERef -> IO () -removeFromWorld systems e = mapM (\s -> removeERef s e) systems >> return () +-- | remove an Entity from the world, thread safe +removeFromWorld :: [SystemData] -> Entity -> IO () +removeFromWorld systems e = mapM (\s -> removeEntity s e) systems >> return ()
+ HGamer3D/GUI.hs view
@@ -0,0 +1,34 @@+{- + Graphical User Interface - GUI + 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.hs +-} + +-- | GUI for HGamer3D +module HGamer3D.GUI + +( + module HGamer3D.GUI.Button + , module HGamer3D.GUI.EditText + , module HGamer3D.GUI.Text + , module HGamer3D.GUI.Slider + , module HGamer3D.GUI.DropDownList + , module HGamer3D.GUI.CheckBox +) + +where + +import HGamer3D.GUI.Button +import HGamer3D.GUI.EditText +import HGamer3D.GUI.Text +import HGamer3D.GUI.Slider +import HGamer3D.GUI.DropDownList +import HGamer3D.GUI.CheckBox + +
+ HGamer3D/GUI/Button.hs view
@@ -0,0 +1,30 @@+{- + 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 Mouse functionality and settings +module HGamer3D.GUI.Button +( + ctButton +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +ctButton :: ComponentType Bool +ctButton = ComponentType 0x68a1857c27690b30 + +
+ HGamer3D/GUI/CheckBox.hs view
@@ -0,0 +1,30 @@+{- + GUI: Checkbox 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/CheckBox.hs +-} + +-- | Module providing the CheckBox gui element +module HGamer3D.GUI.CheckBox +( + ctCheckBox +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +ctCheckBox :: ComponentType Bool +ctCheckBox = ComponentType 0xd2425f880fcdd9a4 + +
+ HGamer3D/GUI/DropDownList.hs view
@@ -0,0 +1,37 @@+{- + GUI: DropDownList 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/DropDownList.hs +-} + +-- | Module providing the Mouse functionality and settings +module HGamer3D.GUI.DropDownList +( + ctDropDownList, + DropDownList (..) +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +data DropDownList = DropDownList [Text] (Maybe Int) deriving (Eq, Show) -- int is selected item index, starting at 0 + +instance ComponentClass DropDownList where + toObj (DropDownList textlist mb) = ObjectArray [ ObjectArray (Prelude.map toObj textlist), toObj mb] + fromObj (ObjectArray [ ObjectArray textlist_o, mb]) = DropDownList (Prelude.map fromObj textlist_o) (fromObj mb) + +ctDropDownList :: ComponentType DropDownList +ctDropDownList = ComponentType 0x200de0e837a8e590 + +
+ HGamer3D/GUI/EditText.hs view
@@ -0,0 +1,28 @@+{- + GUI: EditText 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/EditText.hs +-} + +-- | Module providing the Mouse functionality and settings +module HGamer3D.GUI.EditText +( + ctEditText +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +ctEditText :: ComponentType Text +ctEditText = ComponentType 0x8c79de2199331f3a
+ HGamer3D/GUI/Slider.hs view
@@ -0,0 +1,38 @@+{- + GUI: Slider 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/Slider.hs +-} + +-- | Module providing the Mouse functionality and settings +module HGamer3D.GUI.Slider +( + ctSlider, + Slider (..) +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +data Slider = Slider Float Float -- range end (start = 0) and value + deriving (Eq, Show) + +instance ComponentClass Slider where + toObj (Slider range value) = ObjectArray [ObjectFloat range, ObjectFloat value] + fromObj (ObjectArray [ObjectFloat range, ObjectFloat value]) = Slider range value + +ctSlider :: ComponentType Slider +ctSlider = ComponentType 0x60636b107c77a533 + +
+ HGamer3D/GUI/Text.hs view
@@ -0,0 +1,30 @@+{- + GUI: Text 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/Text.hs +-} + +-- | Module providing the Mouse functionality and settings +module HGamer3D.GUI.Text +( + ctText +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +ctText :: ComponentType Text +ctText = ComponentType 0xda9601eaf3319280 + +
HGamer3D/Graphics3D/Geometry.hs view
@@ -35,6 +35,7 @@ import HGamer3D.Data import HGamer3D.Graphics3D.Material +-- CH4-4s -- | A shape is a basic geometric form data Shape = Sphere | Cube @@ -44,6 +45,16 @@ | Torus deriving (Eq, Show) +-- | A geometry is the basic drawable item, it can be a shape or a mesh loaded from a resource +data Geometry = ShapeGeometry Shape + | ResourceGeometry Text + deriving (Eq, Show) + +-- | Component Type for the Geometry +ctGeometry :: ComponentType Geometry +ctGeometry = ComponentType 0xee433d1a4b964591 +-- CH4-4e + instance ComponentClass Shape where toObj shape = case shape of Sphere -> (ObjectInt 1) @@ -60,15 +71,6 @@ 5 -> Pyramid 6 -> Torus --- | A geometry is the basic drawable item, it can be a shape or a mesh loaded from a resource -data Geometry = ShapeGeometry Shape - | ResourceGeometry Text - deriving (Eq, Show) - --- | Component Type for the Geometry -ctGeometry :: ComponentType Geometry -ctGeometry = ComponentType 0xee433d1a4b964591 - instance ComponentClass Geometry where toObj (ShapeGeometry sh) = ObjectArray [ObjectInt 1, toObj sh] toObj (ResourceGeometry mesh) = ObjectArray [ObjectInt 2, toObj mesh]
HGamer3D/Graphics3D/SystemGraphics3D.hs view
@@ -58,6 +58,8 @@ import HGamer3D.Graphics3D.Geometry import HGamer3D.Graphics3D.Material import HGamer3D.Input +import HGamer3D.GUI +import HGamer3D.Audio w64 (ComponentType w) = w @@ -66,43 +68,69 @@ lock <- newMVar () ne <- newIORef [] de <- newIORef [] - return $ SystemData lock ne de [] - -- TABLE OF RECOGNIZED COMPONENTS - - -- Components, which can be created: - [ - w64 ctGraphics3DConfig, - w64 ctCamera, - w64 ctLight, - w64 ctGeometry, - w64 ctMouse, - w64 ctKeyEvent - ] - - -- Properties, which receive messages: - [ - w64 ctPosition, - w64 ctScale, - w64 ctOrientation, - w64 ctGraphics3DCommand, - w64 ctMaterial, - w64 ctColour, - w64 ctVisible - ] - - -- Properties, which send messages: - [ - w64 ctMouseEvent, - w64 ctVisible, - w64 ctKeyEvent - ] - - B.createItem - B.destroyItem - B.getMessageSender - B.registerMessageReceiver - B.errorMessage + + return $ SystemData lock ne de [] + +-- CH4-5s + -- TABLE OF RECOGNIZED COMPONENTS + + -- Components, which are objects that means they can be created (and modified if supported): + [ + w64 ctGraphics3DConfig + , w64 ctCamera + , w64 ctLight + , w64 ctGeometry + + , w64 ctMouse + , w64 ctInputEventHandler + + , w64 ctButton + , w64 ctEditText + , w64 ctText + , w64 ctSlider + , w64 ctCheckBox + , w64 ctDropDownList + + , w64 ctSoundSource + , w64 ctSoundListener + , w64 ctVolume + ] + + -- Components, which are properties, they can be set on objects: + [ + w64 ctPosition + , w64 ctScale + , w64 ctOrientation + , w64 ctGraphics3DCommand + , w64 ctMaterial + , w64 ctColour + , w64 ctVisible + , w64 ctScreenRect + , w64 ctPlayCmd + ] + + -- Event receiver, they cannot set by API, they are set by C library (they send messages): + [ + -- events are only receiver + w64 ctMouseEvent + , w64 ctKeyEvent + + -- gui elements are both sender and receiver ! + , w64 ctEditText + , w64 ctButton + , w64 ctSlider + , w64 ctCheckBox + , w64 ctDropDownList + ] + +-- CH4-5e + B.createItem + B.destroyItem + B.getMessageSender + B.registerMessageReceiver + B.errorMessage + -- | start a graphics world forkGraphics3DWorld :: IO Bool -> GameTime -> IO [SystemData] forkGraphics3DWorld stepF sleepT = do
HGamer3D/Input.hs view
@@ -25,7 +25,8 @@ ( module HGamer3D.Input.Mouse, module HGamer3D.Input.Keyboard, - module HGamer3D.Input.Joystick + module HGamer3D.Input.Joystick, + module HGamer3D.Input.InputEventHandler ) where @@ -33,5 +34,6 @@ import HGamer3D.Input.Mouse import HGamer3D.Input.Keyboard import HGamer3D.Input.Joystick +import HGamer3D.Input.InputEventHandler
+ HGamer3D/Input/InputEventHandler.hs view
@@ -0,0 +1,70 @@+{- + Input Event handler and settings + 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/Input/Mouse.hs +-} + +-- | Module providing settings for all input events (Mouse, Keyboard, Joystick) +module HGamer3D.Input.InputEventHandler +( + InputEventType (..), + InputEventHandler (..), + ctInputEventHandler +) + +where + +import Data.MessagePack +import Debug.Trace +import Data.Text + +import HGamer3D.Data + +data InputEventType = IEMouseButtonUp + | IEMouseButtonDown + | IEMouseMove + | IEMouseButtonWheel + | IEMouseButtonVisibleChanged + | IEKeyUp + | IEKeyDown + + deriving (Eq, Show) + +instance ComponentClass InputEventType where + + toObj iet = case iet of + IEMouseButtonUp -> ObjectInt 1 + IEMouseButtonDown -> ObjectInt 2 + IEMouseMove -> ObjectInt 3 + IEMouseButtonWheel -> ObjectInt 4 + IEMouseButtonVisibleChanged -> ObjectInt 5 + IEKeyUp -> ObjectInt 6 + IEKeyDown -> ObjectInt 7 + fromObj (ObjectInt n) = case n of + 1 -> IEMouseButtonUp + 2 -> IEMouseButtonDown + 3 -> IEMouseMove + 4 -> IEMouseButtonWheel + 5 -> IEMouseButtonVisibleChanged + 6 -> IEKeyUp + 7 -> IEKeyDown + +data InputEventHandler = DefaultEventHandler + | SpecificEventHandler [InputEventType] + +instance ComponentClass InputEventHandler where + toObj DefaultEventHandler = ObjectArray [ObjectInt 0] + toObj (SpecificEventHandler iets) = ObjectArray [ObjectInt 1, ObjectArray (Prelude.map toObj iets)] + + fromObj (ObjectArray [ObjectInt 0]) = DefaultEventHandler + fromObj (ObjectArray [ObjectInt 1, (ObjectArray iets_os)]) = SpecificEventHandler (Prelude.map fromObj iets_os) + +ctInputEventHandler :: ComponentType InputEventHandler +ctInputEventHandler = ComponentType 0xfc0edefcebcb5878 +
− HGamer3D/Input/InputEvents.hs
@@ -1,59 +0,0 @@--- 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/Input/InputEvents.hs---- | Module providing the MouseInput type--module HGamer3D.Input.InputEvents--(- ctInputEventHub,- ctMouseEvent,-- MouseEvent (..)-)--where--import Data.MessagePack-import Debug.Trace-import Data.Text--import HGamer3D.Data--ctInputEventHub :: ComponentType ()-ctInputEventHub = ComponentType 0xa532f43b1c1c6bc7--ctMouseEvent :: ComponentType MouseEvent-ctMouseEvent = ComponentType 0x27eaf3fd46595d08--data MouseEvent = MousePosition Int Int- | MouseButtonUp Int- | MouseButtonDown Int- deriving (Eq, Show)--instance ComponentClass MouseEvent where- toObj (MousePosition x y) = ObjectArray [ObjectInt 1, ObjectInt (fromIntegral x), ObjectInt (fromIntegral y)]- toObj (MouseButtonDown b) = ObjectArray [ObjectInt 2, ObjectInt (fromIntegral b)]- toObj (MouseButtonUp b) =ObjectArray [ObjectInt 3, ObjectInt (fromIntegral b)]- fromObj (ObjectArray [ObjectInt 1, ObjectInt x, ObjectInt y]) = MousePosition (fromIntegral x) (fromIntegral y)- fromObj (ObjectArray [ObjectInt 2, ObjectInt b]) = MouseButtonDown (fromIntegral b)- fromObj (ObjectArray [ObjectInt 3, ObjectInt b]) = MouseButtonUp (fromIntegral b)- fromObj obj = trace (show obj) (MousePosition 0 0)-
HGamer3D/Input/Keyboard.hs view
@@ -26,13 +26,17 @@ import HGamer3D.Data -data KeyEvent = KeyUp Int Int Text -- Key, Scancode, Name +data KeyEvent = NoKeyEvent + | KeyUp Int Int Text -- Key, Scancode, Name | KeyDown Int Int Text -- Key, Scancode, Name deriving (Eq, Show) instance ComponentClass KeyEvent where + toObj NoKeyEvent = ObjectArray [ObjectInt 0] toObj (KeyUp k s n) = ObjectArray [ObjectInt 1, ObjectInt (fromIntegral k), ObjectInt (fromIntegral s), toObj n] toObj (KeyDown k s n) = ObjectArray [ObjectInt 2, ObjectInt (fromIntegral k), ObjectInt (fromIntegral s), toObj n] + + fromObj (ObjectArray [ObjectInt 0]) = NoKeyEvent fromObj (ObjectArray [ObjectInt 1, ObjectInt k, ObjectInt s, n_o]) = KeyUp (fromIntegral k) (fromIntegral s) (fromObj n_o) fromObj (ObjectArray [ObjectInt 2, ObjectInt k, ObjectInt s, n_o]) = KeyDown (fromIntegral k) (fromIntegral s) (fromObj n_o)
HGamer3D/Input/Mouse.hs view
@@ -55,7 +55,8 @@ -- Mouse Events -data MouseEvent = MouseButtonUp Int Int Int -- Button, Buttons, Qualifiers +data MouseEvent = NoMouseEvent + | MouseButtonUp Int Int Int -- Button, Buttons, Qualifiers | MouseButtonDown Int Int Int -- Button, Buttons, Qualifiers | MouseMove Int Int Int Int Int Int -- X, Y, DX, DY, Buttons, Qualifiers | MouseWheel Int Int Int -- Wheel, Buttons, Qualifiers @@ -63,12 +64,14 @@ deriving (Eq, Show) instance ComponentClass MouseEvent where + toObj NoMouseEvent = ObjectArray [ObjectInt 0] toObj (MouseButtonUp b bs qs) = ObjectArray [ObjectInt 1, ObjectInt (fromIntegral b), ObjectInt (fromIntegral bs), ObjectInt (fromIntegral qs)] toObj (MouseButtonDown b bs qs) = ObjectArray [ObjectInt 2, ObjectInt (fromIntegral b), ObjectInt (fromIntegral bs), ObjectInt (fromIntegral qs)] toObj (MouseMove x y dx dy bs qs) = ObjectArray [ObjectInt 3, ObjectInt (fromIntegral x), ObjectInt (fromIntegral y), ObjectInt (fromIntegral dx), ObjectInt (fromIntegral dy), ObjectInt (fromIntegral bs), ObjectInt (fromIntegral qs)] toObj (MouseWheel w bs qs) = ObjectArray [ObjectInt 4, ObjectInt (fromIntegral w), ObjectInt (fromIntegral bs), ObjectInt (fromIntegral qs)] toObj (MouseVisibleChanged v) = ObjectArray [ObjectInt 5, ObjectBool v] + fromObj (ObjectArray [ObjectInt 0]) = NoMouseEvent fromObj (ObjectArray [ObjectInt 1, ObjectInt b, ObjectInt bs, ObjectInt qs]) = MouseButtonUp (fromIntegral b) (fromIntegral bs) (fromIntegral qs) fromObj (ObjectArray [ObjectInt 2, ObjectInt b, ObjectInt bs, ObjectInt qs]) = MouseButtonDown (fromIntegral b) (fromIntegral bs) (fromIntegral qs) fromObj (ObjectArray [ObjectInt 3, ObjectInt x, ObjectInt y, ObjectInt dx, ObjectInt dy, ObjectInt bs, ObjectInt qs]) = MouseMove (fromIntegral x) (fromIntegral y) (fromIntegral dx) (fromIntegral dy) (fromIntegral bs) (fromIntegral qs)