eliminate msg

This commit is contained in:
nek0 2017-12-12 13:12:06 +01:00
parent 853951df5b
commit f44021f034
6 changed files with 19 additions and 20 deletions

View file

@ -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

View file

@ -2,6 +2,5 @@ module Affection.MessageBus.Message.Class where
import Data.Word (Word32(..))
class Message msg where
msgTime :: msg -> Word32

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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