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. -- | Main function which bootstraps everything else.
withAffection withAffection
:: AffectionConfig us msg -- ^ Configuration of the Game and its engine. :: AffectionConfig us -- ^ Configuration of the Game and its engine.
-> IO () -> IO ()
withAffection AffectionConfig{..} = do withAffection AffectionConfig{..} = do
-- intialiaze SDL -- intialiaze SDL

View file

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

View file

@ -17,7 +17,7 @@ class MouseClickable a us where
-> (Int, Int) -- The coordinates of the click -> (Int, Int) -- The coordinates of the click
-> SDL.InputMotion -- The 'SDL.InputMotion' of the click -> SDL.InputMotion -- The 'SDL.InputMotion' of the click
-> Int -- The number of clicks -> Int -- The number of clicks
-> Affection us msg () -> Affection us ()
-- | A helper function that checks wether provided clickables have been clicked. -- | A helper function that checks wether provided clickables have been clicked.
-- This function does not consume provided events, but passes them on. -- This function does not consume provided events, but passes them on.
@ -25,7 +25,7 @@ handleMouseClicks
:: (Foldable t, MouseClickable clickable us) :: (Foldable t, MouseClickable clickable us)
=> SDL.EventPayload -- ^ Piped event in => SDL.EventPayload -- ^ Piped event in
-> t clickable -- ^ 'MouseClickable' elemt to be checked -> t clickable -- ^ 'MouseClickable' elemt to be checked
-> Affection us msg SDL.EventPayload -- ^ Unaltered event -> Affection us SDL.EventPayload -- ^ Unaltered event
handleMouseClicks e clickables = handleMouseClicks e clickables =
case e of case e of
SDL.MouseButtonEvent dat -> do SDL.MouseButtonEvent dat -> do

View file

@ -7,8 +7,8 @@ import Affection.Types
import qualified SDL import qualified SDL
class StateMachine a us where class StateMachine a us where
smLoad :: a -> Affection us msg () smLoad :: a -> Affection us ()
smUpdate :: a -> Double -> Affection us msg () smUpdate :: a -> Double -> Affection us ()
smEvent :: a -> SDL.EventPayload -> Affection us msg () smEvent :: a -> SDL.EventPayload -> Affection us ()
smDraw :: a -> Affection us msg () smDraw :: a -> Affection us ()
smClean :: a -> Affection us msg () smClean :: a -> Affection us ()

View file

@ -85,7 +85,7 @@ data InitComponents
| Only [SDL.InitFlag] | Only [SDL.InitFlag]
-- | Main type for defining the look, feel and action of the whole application. -- | 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. -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
{ quitEvent :: Bool -- ^ Loop breaker. { quitEvent :: Bool -- ^ Loop breaker.
, userState :: us -- ^ State data provided by user , userState :: us -- ^ State data provided by user
@ -125,11 +125,11 @@ data AffectionData us msg = AffectionData
type AffectionStateInner us a = StateT us a type AffectionStateInner us a = StateT us a
-- | Affection's state monad -- | Affection's state monad
newtype AffectionState us a = AffectionState newtype AffectionState us m a = AffectionState
{ runState :: AffectionStateInner us a } { runState :: AffectionStateInner us m a }
deriving (Functor, Applicative, Monad, MonadIO, MonadState us) 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 type Affection us a = AffectionState (AffectionData us) IO a

View file

@ -10,12 +10,12 @@ import System.Clock
import Control.Monad.State import Control.Monad.State
-- Prehandle SDL events in case any window events occur -- 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 = preHandleEvents evs =
return $ map SDL.eventPayload evs return $ map SDL.eventPayload evs
-- | Return the userstate to the user -- | Return the userstate to the user
getAffection :: Affection us msg us getAffection :: Affection us us
getAffection = do getAffection = do
ad <- get ad <- get
return $ userState ad return $ userState ad
@ -23,7 +23,7 @@ getAffection = do
-- | Put altered user state back -- | Put altered user state back
putAffection putAffection
:: us -- User state :: us -- User state
-> Affection us msg () -> Affection us ()
putAffection us = do putAffection us = do
ad <- get ad <- get
put $ ad put $ ad
@ -36,20 +36,20 @@ delaySec
delaySec dur = SDL.delay (fromIntegral $ dur * 1000) delaySec dur = SDL.delay (fromIntegral $ dur * 1000)
-- | Get time since start but always the same in the current tick. -- | Get time since start but always the same in the current tick.
getElapsedTime :: Affection us msg Double getElapsedTime :: Affection us Double
getElapsedTime = getElapsedTime =
elapsedTime <$> get elapsedTime <$> get
getDelta :: Affection us msg Double getDelta :: Affection us Double
getDelta = getDelta =
deltaTime <$> get deltaTime <$> get
quit :: Affection us msg () quit :: Affection us ()
quit = do quit = do
ad <- get ad <- get
put $ ad { quitEvent = True } put $ ad { quitEvent = True }
toggleScreen :: Affection us msg () toggleScreen :: Affection us ()
toggleScreen = do toggleScreen = do
ad <- get ad <- get
newMode <- case screenMode ad of newMode <- case screenMode ad of