nek0/affection
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

version bump

Browse source
This commit is contained in:
nek0 2017-12-27 18:43:13 +01:00
parent ea9c406640
commit a1ab48009f
2 changed files with 17 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
affection.cabal
View file

@ -6,7 +6,7 @@ name: affection
-- PVP summary: +-+------- breaking API changes -- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions -- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change -- | | | +--- code changes with no API change
version: 0.0.0.7 version: 0.0.0.8
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. written in Haskell using SDL.

25
examples/example00.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
import Affection import Affection
import qualified SDL import qualified SDL
@ -20,7 +21,9 @@ newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())])
newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())]) newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())])
newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> 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 partSubscribers (Window t) = do
subTups <- liftIO $ readTVarIO t subTups <- liftIO $ readTVarIO t
return $ map snd subTups return $ map snd subTups
@ -28,15 +31,17 @@ instance Participant Window WindowMessage StateData where
partSubscribe (Window t) funct = do partSubscribe (Window t) funct = do
uuid <- genUUID uuid <- genUUID
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) 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)) liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
instance SDLSubsystem Window StateData where instance SDLSubsystem Window StateData where
consumeSDLEvents = consumeSDLWindowEvents consumeSDLEvents = consumeSDLWindowEvents
instance Participant Mouse MouseMessage StateData where instance Participant Mouse StateData where
type Mesg Mouse StateData = MouseMessage
partSubscribers (Mouse t) = do partSubscribers (Mouse t) = do
subTups <- liftIO $ readTVarIO t subTups <- liftIO $ readTVarIO t
return $ map snd subTups return $ map snd subTups
@ -44,15 +49,17 @@ instance Participant Mouse MouseMessage StateData where
partSubscribe (Mouse t) funct = do partSubscribe (Mouse t) funct = do
uuid <- genUUID uuid <- genUUID
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) 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)) liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
instance SDLSubsystem Mouse StateData where instance SDLSubsystem Mouse StateData where
consumeSDLEvents = consumeSDLMouseEvents consumeSDLEvents = consumeSDLMouseEvents
instance Participant Keyboard KeyboardMessage StateData where instance Participant Keyboard StateData where
type Mesg Keyboard StateData = KeyboardMessage
partSubscribers (Keyboard t) = do partSubscribers (Keyboard t) = do
subTups <- liftIO $ readTVarIO t subTups <- liftIO $ readTVarIO t
return $ map snd subTups return $ map snd subTups
@ -60,9 +67,9 @@ instance Participant Keyboard KeyboardMessage StateData where
partSubscribe (Keyboard t) funct = do partSubscribe (Keyboard t) funct = do
uuid <- genUUID uuid <- genUUID
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) 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)) liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
instance SDLSubsystem Keyboard StateData where instance SDLSubsystem Keyboard StateData where