splitting the messages up

This commit is contained in:
nek0 2017-11-29 17:49:56 +01:00
parent c40cd04d99
commit df2f59c6b9
5 changed files with 105 additions and 105 deletions

View file

@ -44,6 +44,8 @@ library
, Affection.MessageBus.Util , Affection.MessageBus.Util
, Affection.MessageBus.Class , Affection.MessageBus.Class
, Affection.MessageBus.Message , Affection.MessageBus.Message
, Affection.MessageBus.Message.Class
, Affection.MessageBus.Message.WindowMessage
, Affection.Subsystems.Class , Affection.Subsystems.Class
, Affection.Subsystems.AffectionWindow , Affection.Subsystems.AffectionWindow
default-extensions: OverloadedStrings default-extensions: OverloadedStrings

View file

@ -3,21 +3,12 @@
module Affection module Affection
( withAffection ( withAffection
, get , get
, getAffection
, putAffection
, delaySec
, get
, put , put
, module A , module A
) where ) where
import SDL (($=)) import SDL (($=))
import qualified SDL import qualified SDL
import qualified SDL.Internal.Numbered as SDL (toNumber)
import qualified SDL.Raw as Raw
import Data.Maybe
import Data.IORef
import System.Clock import System.Clock
@ -25,7 +16,6 @@ import Control.Monad.Loops
import Control.Monad.State import Control.Monad.State
import Foreign.C.Types (CInt(..)) import Foreign.C.Types (CInt(..))
import Foreign.Storable (peek)
import Debug.Trace import Debug.Trace
@ -95,7 +85,8 @@ withAffection AffectionConfig{..} = do
now <- liftIO $ getTime Monotonic now <- liftIO $ getTime Monotonic
let lastTime = sysTime ad let lastTime = sysTime ad
-- compute dt and update elapsedTime -- compute dt and update elapsedTime
let !dt = fromIntegral (toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ 9) let !dt = fromIntegral
(toNanoSecs $ diffTimeSpec lastTime now) / (10 ^ (9 :: Int))
!ne = elapsedTime ad + dt !ne = elapsedTime ad + dt
put $ ad put $ ad
{ elapsedTime = ne { elapsedTime = ne

View file

@ -1,95 +1,6 @@
{-# LANGUAGE RankNTypes #-} module Affection.MessageBus.Message
module Affection.MessageBus.Message where ( module M
) where
import Data.Word (Word32(..)) import Affection.MessageBus.Message.Class as M
import Data.Int (Int32(..)) import Affection.MessageBus.Message.WindowMessage as M
import qualified SDL
import Linear (V2(..))
class Message msg where
msgTime :: msg -> Word32
data SystemMessage
-- = MsgUserMessage
-- { msgUMWhen :: Word32
-- , msgUMPayload :: m
-- } -- ^ Generic user defined message with custom payload
= MsgEngineReady Word32
| MsgWindowShown
{ msgWSWhen :: Word32
, msgWSWindow :: SDL.Window
}
| MsgWindowHidden
{ msgWHWhen :: Word32
, msgWHWindow :: SDL.Window
}
| MsgWindowExposed
{ msgWEWhen :: Word32
, msgWEWindow :: SDL.Window
}
| MsgWindowMoved
{ msgWMWhen :: Word32
, msgWMWindow :: SDL.Window
, msgWMNewPos :: V2 Int32
}
| MsgWindowResized
{ msgWRWhen :: Word32
, msgWRWindow :: SDL.Window
, msgWRNewSize :: V2 Int32
}
| MsgWindowSizeChanged
{ msgWSCWhen :: Word32
, msgWSCWindow :: SDL.Window
}
| MsgWindowMinimized
{ msgWMinWhen :: Word32
, msgWMinWindow :: SDL.Window
}
| MsgWindowMaximized
{ msgWMaxWhen :: Word32
, msgWMaxWindow :: SDL.Window
}
| MsgWindowRestored
{ msgWRestWhen :: Word32
, msgWRestWindow :: SDL.Window
}
| MsgWindowGainedMouseFocus
{ msgWGMFWhen :: Word32
, msgWGMFWindow :: SDL.Window
}
| MsgWindowLostMouseFocus
{ msgWLMFWhen :: Word32
, msgWLMFWindow :: SDL.Window
}
| MsgWindowGainedKeyboardFocus
{ msgWGKFWhen :: Word32
, msgWGKFWindow :: SDL.Window
}
| MsgWindowLostKeyboardFocus
{ msgWLKFWhen :: Word32
, msgWLKFWindow :: SDL.Window
}
| MsgWindowClosed
{ msgWCWhen :: Word32
, msgWCWindow :: SDL.Window
}
instance Message SystemMessage where
-- msgTime (MsgUserMessage t _) = t
msgTime (MsgEngineReady t) = t
msgTime (MsgWindowShown t _) = t
msgTime (MsgWindowHidden t _) = t
msgTime (MsgWindowExposed t _) = t
msgTime (MsgWindowMoved t _ _) = t
msgTime (MsgWindowResized t _ _) = t
msgTime (MsgWindowSizeChanged t _) = t
msgTime (MsgWindowMinimized t _) = t
msgTime (MsgWindowMaximized t _) = t
msgTime (MsgWindowRestored t _) = t
msgTime (MsgWindowGainedMouseFocus t _) = t
msgTime (MsgWindowLostMouseFocus t _) = t
msgTime (MsgWindowGainedKeyboardFocus t _) = t
msgTime (MsgWindowLostKeyboardFocus t _) = t
msgTime (MsgWindowClosed t _) = t

View file

@ -0,0 +1,7 @@
module Affection.MessageBus.Message.Class where
import Data.Word (Word32(..))
class Message msg where
msgTime :: msg -> Word32

View file

@ -0,0 +1,89 @@
{-# LANGUAGE RankNTypes #-}
module Affection.MessageBus.Message.WindowMessage where
import Affection.MessageBus.Message.Class
import Data.Word (Word32(..))
import Data.Int (Int32(..))
import qualified SDL
import Linear (V2(..))
data SystemMessage
= MsgEngineReady Word32
| MsgWindowShown
{ msgWSWhen :: Word32
, msgWSWindow :: SDL.Window
}
| MsgWindowHidden
{ msgWHWhen :: Word32
, msgWHWindow :: SDL.Window
}
| MsgWindowExposed
{ msgWEWhen :: Word32
, msgWEWindow :: SDL.Window
}
| MsgWindowMoved
{ msgWMWhen :: Word32
, msgWMWindow :: SDL.Window
, msgWMNewPos :: V2 Int32
}
| MsgWindowResized
{ msgWRWhen :: Word32
, msgWRWindow :: SDL.Window
, msgWRNewSize :: V2 Int32
}
| MsgWindowSizeChanged
{ msgWSCWhen :: Word32
, msgWSCWindow :: SDL.Window
}
| MsgWindowMinimized
{ msgWMinWhen :: Word32
, msgWMinWindow :: SDL.Window
}
| MsgWindowMaximized
{ msgWMaxWhen :: Word32
, msgWMaxWindow :: SDL.Window
}
| MsgWindowRestored
{ msgWRestWhen :: Word32
, msgWRestWindow :: SDL.Window
}
| MsgWindowGainedMouseFocus
{ msgWGMFWhen :: Word32
, msgWGMFWindow :: SDL.Window
}
| MsgWindowLostMouseFocus
{ msgWLMFWhen :: Word32
, msgWLMFWindow :: SDL.Window
}
| MsgWindowGainedKeyboardFocus
{ msgWGKFWhen :: Word32
, msgWGKFWindow :: SDL.Window
}
| MsgWindowLostKeyboardFocus
{ msgWLKFWhen :: Word32
, msgWLKFWindow :: SDL.Window
}
| MsgWindowClosed
{ msgWCWhen :: Word32
, msgWCWindow :: SDL.Window
}
instance Message SystemMessage where
msgTime (MsgEngineReady t) = t
msgTime (MsgWindowShown t _) = t
msgTime (MsgWindowHidden t _) = t
msgTime (MsgWindowExposed t _) = t
msgTime (MsgWindowMoved t _ _) = t
msgTime (MsgWindowResized t _ _) = t
msgTime (MsgWindowSizeChanged t _) = t
msgTime (MsgWindowMinimized t _) = t
msgTime (MsgWindowMaximized t _) = t
msgTime (MsgWindowRestored t _) = t
msgTime (MsgWindowGainedMouseFocus t _) = t
msgTime (MsgWindowLostMouseFocus t _) = t
msgTime (MsgWindowGainedKeyboardFocus t _) = t
msgTime (MsgWindowLostKeyboardFocus t _) = t
msgTime (MsgWindowClosed t _) = t