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