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
|
||||
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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -33,7 +33,7 @@ data MouseMessage
|
|||
, msgMWPos :: V2 Int32
|
||||
, msgMWDIrection :: SDL.MouseScrollDirection
|
||||
}
|
||||
| MsgMouseEmptyMessage
|
||||
| MsgMouseEmptyEvent
|
||||
deriving (Show)
|
||||
|
||||
instance Message MouseMessage where
|
||||
|
|
Loading…
Reference in a new issue