diff --git a/affection.cabal b/affection.cabal index 13c6e21..a290eb8 100644 --- a/affection.cabal +++ b/affection.cabal @@ -9,7 +9,7 @@ name: affection version: 0.0.0.7 synopsis: A simple Game Engine using SDL description: This package contains Affection, a simple game engine - written in Haskell using SDL and GEGL. + written in Haskell using SDL. This Engine is still work in progress and even minor version bumps may contain breaking api changes. homepage: https://github.com/nek0/affection#readme @@ -19,6 +19,7 @@ author: nek0 maintainer: nek0@chelnok.de category: Game build-type: Simple +extra-source-files: ChangeLog.md -- Extra files to be distributed with the package, such as examples or a -- README. @@ -97,7 +98,7 @@ library default-language: Haskell2010 ghc-options: -Wall -- Other library packages from which modules are imported. - build-depends: base >=4.9 + build-depends: base >=4.9 && < 5 , sdl2 , linear , text @@ -112,20 +113,16 @@ library , stm , uuid +-- This example shows the message system. only makes sense when compiling with +-- verbose flag. executable example00 - if flag(debug) - cpp-options: -DDEBUG - if flag(warn) - cpp-options: -DWARN - if flag(error) - cpp-options: -DERROR hs-source-dirs: examples main-is: example00.hs ghc-options: -threaded -Wall default-language: Haskell2010 default-extensions: OverloadedStrings if flag(examples) - build-depends: base + build-depends: base >=4.9 && < 5 , affection , sdl2 , stm diff --git a/examples/example00.hs b/examples/example00.hs index e57e5f7..8d12f6f 100644 --- a/examples/example00.hs +++ b/examples/example00.hs @@ -25,9 +25,12 @@ instance Participant Window WindowMessage StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Window t) = generalSubscribe t + partSubscribe (Window t) funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return $ MsgId uuid MsgWindowEmptyEvent - partUnSubscribe (Window t) uuid = + partUnSubscribe (Window t) (MsgId uuid _) = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) instance SDLSubsystem Window StateData where @@ -38,9 +41,12 @@ instance Participant Mouse MouseMessage StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Mouse t) = generalSubscribe t + partSubscribe (Mouse t) funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return $ MsgId uuid MsgMouseEmptyEvent - partUnSubscribe (Mouse t) uuid = + partUnSubscribe (Mouse t) (MsgId uuid _) = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) instance SDLSubsystem Mouse StateData where @@ -51,19 +57,17 @@ instance Participant Keyboard KeyboardMessage StateData where subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Keyboard t) = generalSubscribe t + partSubscribe (Keyboard t) funct = do + uuid <- genUUID + liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) + return $ MsgId uuid MsgKeyboardEmptyEvent - partUnSubscribe (Keyboard t) uuid = + partUnSubscribe (Keyboard t) (MsgId uuid _) = liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid)) instance SDLSubsystem Keyboard StateData where consumeSDLEvents = consumeSDLKeyboardEvents -generalSubscribe t funct = do - uuid <- genUUID - liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) - return uuid - main :: IO () main = do logIO Debug "Starting" diff --git a/src/Affection.hs b/src/Affection.hs index d89caec..aa842a5 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -87,7 +87,7 @@ withAffection AffectionConfig{..} = do Just (cw, ch) -> (cw, ch) Nothing -> (fromIntegral rw, fromIntegral rh) SDL.setWindowMode window initScreenMode - SDL.swapInterval $= SDL.SynchronizedUpdates + SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows liftIO $ logIO Debug "Getting Time" -- get current time execTime <- getTime Monotonic diff --git a/src/Affection/MessageBus/Message/MouseMessage.hs b/src/Affection/MessageBus/Message/MouseMessage.hs index a28676a..ba56ae2 100644 --- a/src/Affection/MessageBus/Message/MouseMessage.hs +++ b/src/Affection/MessageBus/Message/MouseMessage.hs @@ -33,7 +33,7 @@ data MouseMessage , msgMWPos :: V2 Int32 , msgMWDIrection :: SDL.MouseScrollDirection } - | MsgMouseEmptyMessage + | MsgMouseEmptyEvent deriving (Show) instance Message MouseMessage where