eliminate msg
This commit is contained in:
parent
853951df5b
commit
f44021f034
6 changed files with 19 additions and 20 deletions
|
@ -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
|
||||
|
|
|
@ -2,6 +2,5 @@ module Affection.MessageBus.Message.Class where
|
|||
|
||||
import Data.Word (Word32(..))
|
||||
|
||||
|
||||
class Message msg where
|
||||
msgTime :: msg -> Word32
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue