splitting the messages up
This commit is contained in:
nek0
parent
c40cd04d99
commit
df2f59c6b9
5 changed files with 105 additions and 105 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
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