new version

This commit is contained in:
nek0 2017-12-24 00:39:52 +01:00
parent ecd1943a39
commit e8fe302208
4 changed files with 23 additions and 22 deletions

View file

@ -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

View file

@ -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"

View file

@ -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

View file

@ -33,7 +33,7 @@ data MouseMessage
, msgMWPos :: V2 Int32
, msgMWDIrection :: SDL.MouseScrollDirection
}
| MsgMouseEmptyMessage
| MsgMouseEmptyEvent
deriving (Show)
instance Message MouseMessage where