version bump
This commit is contained in:
parent
ea9c406640
commit
a1ab48009f
2 changed files with 17 additions and 10 deletions
|
@ -6,7 +6,7 @@ name: affection
|
|||
-- PVP summary: +-+------- breaking API changes
|
||||
-- | | +----- non-breaking API additions
|
||||
-- | | | +--- code changes with no API change
|
||||
version: 0.0.0.7
|
||||
version: 0.0.0.8
|
||||
synopsis: A simple Game Engine using SDL
|
||||
description: This package contains Affection, a simple game engine
|
||||
written in Haskell using SDL.
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
import Affection
|
||||
import qualified SDL
|
||||
|
@ -20,7 +21,9 @@ newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())])
|
|||
newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())])
|
||||
newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())])
|
||||
|
||||
instance Participant Window WindowMessage StateData where
|
||||
instance Participant Window StateData where
|
||||
type Mesg Window StateData = WindowMessage
|
||||
|
||||
partSubscribers (Window t) = do
|
||||
subTups <- liftIO $ readTVarIO t
|
||||
return $ map snd subTups
|
||||
|
@ -28,15 +31,17 @@ instance Participant Window WindowMessage StateData where
|
|||
partSubscribe (Window t) funct = do
|
||||
uuid <- genUUID
|
||||
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
||||
return $ MsgId uuid MsgWindowEmptyEvent
|
||||
return uuid
|
||||
|
||||
partUnSubscribe (Window t) (MsgId uuid _) =
|
||||
partUnSubscribe (Window t) uuid =
|
||||
liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
|
||||
|
||||
instance SDLSubsystem Window StateData where
|
||||
consumeSDLEvents = consumeSDLWindowEvents
|
||||
|
||||
instance Participant Mouse MouseMessage StateData where
|
||||
instance Participant Mouse StateData where
|
||||
type Mesg Mouse StateData = MouseMessage
|
||||
|
||||
partSubscribers (Mouse t) = do
|
||||
subTups <- liftIO $ readTVarIO t
|
||||
return $ map snd subTups
|
||||
|
@ -44,15 +49,17 @@ instance Participant Mouse MouseMessage StateData where
|
|||
partSubscribe (Mouse t) funct = do
|
||||
uuid <- genUUID
|
||||
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
||||
return $ MsgId uuid MsgMouseEmptyEvent
|
||||
return uuid
|
||||
|
||||
partUnSubscribe (Mouse t) (MsgId uuid _) =
|
||||
partUnSubscribe (Mouse t) uuid =
|
||||
liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
|
||||
|
||||
instance SDLSubsystem Mouse StateData where
|
||||
consumeSDLEvents = consumeSDLMouseEvents
|
||||
|
||||
instance Participant Keyboard KeyboardMessage StateData where
|
||||
instance Participant Keyboard StateData where
|
||||
type Mesg Keyboard StateData = KeyboardMessage
|
||||
|
||||
partSubscribers (Keyboard t) = do
|
||||
subTups <- liftIO $ readTVarIO t
|
||||
return $ map snd subTups
|
||||
|
@ -60,9 +67,9 @@ instance Participant Keyboard KeyboardMessage StateData where
|
|||
partSubscribe (Keyboard t) funct = do
|
||||
uuid <- genUUID
|
||||
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
||||
return $ MsgId uuid MsgKeyboardEmptyEvent
|
||||
return uuid
|
||||
|
||||
partUnSubscribe (Keyboard t) (MsgId uuid _) =
|
||||
partUnSubscribe (Keyboard t) uuid =
|
||||
liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
|
||||
|
||||
instance SDLSubsystem Keyboard StateData where
|
||||
|
|
Loading…
Reference in a new issue