From df2f59c6b91eef26899a8055df0bad53914d925c Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 29 Nov 2017 17:49:56 +0100 Subject: [PATCH] splitting the messages up --- affection.cabal | 2 + src/Affection.hs | 13 +-- src/Affection/MessageBus/Message.hs | 99 +------------------ src/Affection/MessageBus/Message/Class.hs | 7 ++ .../MessageBus/Message/WindowMessage.hs | 89 +++++++++++++++++ 5 files changed, 105 insertions(+), 105 deletions(-) create mode 100644 src/Affection/MessageBus/Message/Class.hs create mode 100644 src/Affection/MessageBus/Message/WindowMessage.hs diff --git a/affection.cabal b/affection.cabal index 5315c9d..018d1ff 100644 --- a/affection.cabal +++ b/affection.cabal @@ -44,6 +44,8 @@ library , Affection.MessageBus.Util , Affection.MessageBus.Class , Affection.MessageBus.Message + , Affection.MessageBus.Message.Class + , Affection.MessageBus.Message.WindowMessage , Affection.Subsystems.Class , Affection.Subsystems.AffectionWindow default-extensions: OverloadedStrings diff --git a/src/Affection.hs b/src/Affection.hs index 5022675..59448a2 100644 --- a/src/Affection.hs +++ b/src/Affection.hs @@ -3,21 +3,12 @@ module Affection ( withAffection , get - , getAffection - , putAffection - , delaySec - , get , put , module A ) where import 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 @@ -25,7 +16,6 @@ import Control.Monad.Loops import Control.Monad.State import Foreign.C.Types (CInt(..)) -import Foreign.Storable (peek) import Debug.Trace @@ -95,7 +85,8 @@ withAffection AffectionConfig{..} = do now <- liftIO $ getTime Monotonic let lastTime = sysTime ad -- 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 put $ ad { elapsedTime = ne diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs index b96419d..b1d0d46 100644 --- a/src/Affection/MessageBus/Message.hs +++ b/src/Affection/MessageBus/Message.hs @@ -1,95 +1,6 @@ -{-# LANGUAGE RankNTypes #-} -module Affection.MessageBus.Message where +module Affection.MessageBus.Message + ( module M + ) where -import Data.Word (Word32(..)) -import Data.Int (Int32(..)) - -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 +import Affection.MessageBus.Message.Class as M +import Affection.MessageBus.Message.WindowMessage as M diff --git a/src/Affection/MessageBus/Message/Class.hs b/src/Affection/MessageBus/Message/Class.hs new file mode 100644 index 0000000..bd18c4b --- /dev/null +++ b/src/Affection/MessageBus/Message/Class.hs @@ -0,0 +1,7 @@ +module Affection.MessageBus.Message.Class where + +import Data.Word (Word32(..)) + + +class Message msg where + msgTime :: msg -> Word32 diff --git a/src/Affection/MessageBus/Message/WindowMessage.hs b/src/Affection/MessageBus/Message/WindowMessage.hs new file mode 100644 index 0000000..95b9795 --- /dev/null +++ b/src/Affection/MessageBus/Message/WindowMessage.hs @@ -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