splitting the messages up
This commit is contained in:
parent
c40cd04d99
commit
df2f59c6b9
5 changed files with 105 additions and 105 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
7
src/Affection/MessageBus/Message/Class.hs
Normal file
7
src/Affection/MessageBus/Message/Class.hs
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
module Affection.MessageBus.Message.Class where
|
||||||
|
|
||||||
|
import Data.Word (Word32(..))
|
||||||
|
|
||||||
|
|
||||||
|
class Message msg where
|
||||||
|
msgTime :: msg -> Word32
|
89
src/Affection/MessageBus/Message/WindowMessage.hs
Normal file
89
src/Affection/MessageBus/Message/WindowMessage.hs
Normal 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
|
Loading…
Reference in a new issue