diff --git a/src/Affection.hs b/src/Affection.hs index 59448a2..2917ec7 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -30,7 +30,7 @@ import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..)) -- | Main function which bootstraps everything else. withAffection - :: AffectionConfig us msg -- ^ Configuration of the Game and its engine. + :: AffectionConfig us -- ^ Configuration of the Game and its engine. -> IO () withAffection AffectionConfig{..} = do -- intialiaze SDL diff --git a/src/Affection/MessageBus/Message/Class.hs b/src/Affection/MessageBus/Message/Class.hs index bd18c4b..b97de31 100644 --- a/src/Affection/MessageBus/Message/Class.hs +++ b/src/Affection/MessageBus/Message/Class.hs @@ -2,6 +2,5 @@ module Affection.MessageBus.Message.Class where import Data.Word (Word32(..)) - class Message msg where msgTime :: msg -> Word32 diff --git a/src/Affection/MouseInteractable.hs b/src/Affection/MouseInteractable.hs index 5e0c1f5..e3a6436 100644 --- a/src/Affection/MouseInteractable.hs +++ b/src/Affection/MouseInteractable.hs @@ -17,7 +17,7 @@ class MouseClickable a us where -> (Int, Int) -- The coordinates of the click -> SDL.InputMotion -- The 'SDL.InputMotion' of the click -> Int -- The number of clicks - -> Affection us msg () + -> Affection us () -- | A helper function that checks wether provided clickables have been clicked. -- This function does not consume provided events, but passes them on. @@ -25,7 +25,7 @@ handleMouseClicks :: (Foldable t, MouseClickable clickable us) => SDL.EventPayload -- ^ Piped event in -> t clickable -- ^ 'MouseClickable' elemt to be checked - -> Affection us msg SDL.EventPayload -- ^ Unaltered event + -> Affection us SDL.EventPayload -- ^ Unaltered event handleMouseClicks e clickables = case e of SDL.MouseButtonEvent dat -> do diff --git a/src/Affection/StateMachine.hs b/src/Affection/StateMachine.hs index c2f9f3d..067ae78 100644 --- a/src/Affection/StateMachine.hs +++ b/src/Affection/StateMachine.hs @@ -7,8 +7,8 @@ import Affection.Types import qualified SDL class StateMachine a us where - smLoad :: a -> Affection us msg () - smUpdate :: a -> Double -> Affection us msg () - smEvent :: a -> SDL.EventPayload -> Affection us msg () - smDraw :: a -> Affection us msg () - smClean :: a -> Affection us msg () + smLoad :: a -> Affection us () + smUpdate :: a -> Double -> Affection us () + smEvent :: a -> SDL.EventPayload -> Affection us () + smDraw :: a -> Affection us () + smClean :: a -> Affection us () diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index d5bff6b..8810fe1 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -85,7 +85,7 @@ data InitComponents | Only [SDL.InitFlag] -- | Main type for defining the look, feel and action of the whole application. -data AffectionData us msg = AffectionData +data AffectionData us = AffectionData -- { affectionConfig :: AffectionConfig us -- ^ Application configuration. { quitEvent :: Bool -- ^ Loop breaker. , userState :: us -- ^ State data provided by user @@ -125,11 +125,11 @@ data AffectionData us msg = AffectionData type AffectionStateInner us a = StateT us a -- | Affection's state monad -newtype AffectionState us a = AffectionState - { runState :: AffectionStateInner us a } +newtype AffectionState us m a = AffectionState + { runState :: AffectionStateInner us m a } deriving (Functor, Applicative, Monad, MonadIO, MonadState us) -instance MP.MonadParallel m => MP.MonadParallel (AffectionState us) +instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m) type Affection us a = AffectionState (AffectionData us) IO a diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs index 84d0dd2..9cf794a 100644 --- a/src/Affection/Util.hs +++ b/src/Affection/Util.hs @@ -10,12 +10,12 @@ import System.Clock import Control.Monad.State -- Prehandle SDL events in case any window events occur -preHandleEvents :: [SDL.Event] -> Affection us msg [SDL.EventPayload] +preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload] preHandleEvents evs = return $ map SDL.eventPayload evs -- | Return the userstate to the user -getAffection :: Affection us msg us +getAffection :: Affection us us getAffection = do ad <- get return $ userState ad @@ -23,7 +23,7 @@ getAffection = do -- | Put altered user state back putAffection :: us -- User state - -> Affection us msg () + -> Affection us () putAffection us = do ad <- get put $ ad @@ -36,20 +36,20 @@ delaySec delaySec dur = SDL.delay (fromIntegral $ dur * 1000) -- | Get time since start but always the same in the current tick. -getElapsedTime :: Affection us msg Double +getElapsedTime :: Affection us Double getElapsedTime = elapsedTime <$> get -getDelta :: Affection us msg Double +getDelta :: Affection us Double getDelta = deltaTime <$> get -quit :: Affection us msg () +quit :: Affection us () quit = do ad <- get put $ ad { quitEvent = True } -toggleScreen :: Affection us msg () +toggleScreen :: Affection us () toggleScreen = do ad <- get newMode <- case screenMode ad of