diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs index 6f82190..9a16f94 100644 --- a/src/Affection/MessageBus/Class.hs +++ b/src/Affection/MessageBus/Class.hs @@ -22,25 +22,25 @@ import Data.String as S (fromString) import Affection.Logging -- | This typeclass defines the behaviour of a participant in the message system -class (Message (Mesg prt us), Show (Mesg prt us)) => Participant prt us where +class (Message (Mesg prt), Show (Mesg prt)) => Participant prt where -- | Message datatype - type Mesg prt us :: * + type Mesg prt :: * -- | Function to get the list of subscribers from the participant partSubscribers :: prt -- ^ the 'Participant''s subscriber storage - -> Affection us [Mesg prt us -> Affection us ()] + -> Affection [Mesg prt -> Affection ()] -- ^ List of Subscriber functions -- | Subscribe to the 'Participant''s events partSubscribe :: prt -- ^ The 'Participant''s subscriber storage - -> (Mesg prt us -> Affection us ()) + -> (Mesg prt -> Affection ()) -- ^ What to do in case of a 'Message' -- (Subscriber function) - -> Affection us UUID + -> Affection UUID -- ^ 'UUID' of the registered subscriber Function -- | Unsubscribe a Subscriber function from Participant @@ -49,20 +49,20 @@ class (Message (Mesg prt us), Show (Mesg prt us)) => Participant prt us where -- ^ The 'Participant''s subscriber storage to unsubscribe from -> UUID -- ^ The subscriber function's 'UUID' - -> Affection us () + -> Affection () -- | Get the 'Participant' to emit a 'Message' on all of its subscribers partEmit :: prt -- ^ The 'Participant''s subscriber storage - -> Mesg prt us + -> Mesg prt -- ^ The 'Message' to emit - -> Affection us () + -> Affection () partEmit p m = do liftIO $ logIO Verbose $ "Emitting message: " <> S.fromString (show m) l <- partSubscribers p mapM_ ($ m) l -- | Helper function to generate new 'UUID's -genUUID :: Affection us UUID +genUUID :: Affection UUID genUUID = liftIO nextRandom diff --git a/src/Affection/StateMachine.hs b/src/Affection/StateMachine.hs index c1b5413..1f14abf 100644 --- a/src/Affection/StateMachine.hs +++ b/src/Affection/StateMachine.hs @@ -7,14 +7,14 @@ import Affection.Types import qualified SDL -- | Typeclass for simple scaffolding of a state machine -class StateMachine a us where +class StateMachine a where -- | State load routine - smLoad :: a -> Affection us () + smLoad :: a -> Affection () -- | state update routine - smUpdate :: a -> Double -> Affection us () + smUpdate :: a -> Double -> Affection () -- | State event handler routine - smEvent :: a -> [SDL.EventPayload] -> Affection us () + smEvent :: a -> [SDL.EventPayload] -> Affection () -- | State draw routine - smDraw :: a -> Affection us () + smDraw :: a -> Affection () -- | State clean routine - smClean :: a -> Affection us () + smClean :: a -> Affection () diff --git a/src/Affection/Subsystems/AffectionJoystick.hs b/src/Affection/Subsystems/AffectionJoystick.hs index 5bef780..9d75258 100644 --- a/src/Affection/Subsystems/AffectionJoystick.hs +++ b/src/Affection/Subsystems/AffectionJoystick.hs @@ -22,15 +22,15 @@ import qualified SDL -- | Helper function that consumes all Joystick-related 'SDL.EventPayload's -- and emits appropriate 'JoystickMessage's consumeSDLJoystickEvents - :: forall am us. (Participant am us, Mesg am us ~ JoystickMessage) + :: forall am. (Participant am, Mesg am ~ JoystickMessage) => am -- ^ The message system participant -> [SDL.EventPayload] -- ^ Incoming events - -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events + -> Affection [SDL.EventPayload] -- ^ Leftover SDL events consumeSDLJoystickEvents am = doConsume where doConsume :: [SDL.EventPayload] - -> Affection us [SDL.EventPayload] + -> Affection [SDL.EventPayload] doConsume [] = return [] doConsume (e:es) = do ts <- getElapsedTime @@ -81,7 +81,7 @@ consumeSDLJoystickEvents am = doConsume joystickAutoConnect :: JoystickMessage -- ^ Any 'JoystickMessage' will do, -- but listens only on 'MsgJoystickDevice' messages - -> Affection us (Maybe SDL.Joystick) + -> Affection (Maybe SDL.Joystick) -- ^ Returns a joystick descriptor, if successful joystickAutoConnect (MsgJoystickDevice _ which SDL.JoyDeviceAdded) = liftIO $ do [descr] <- V.toList <$> @@ -98,7 +98,7 @@ joystickAutoDisconnect :: [SDL.Joystick] -- ^ List of Joystick descriptors -> JoystickMessage -- ^ Any 'JoystickMessage' will do, but listens -- specifically to 'MsgJoystickDevice' messages - -> Affection us [SDL.Joystick] -- ^ Returns altered list of Joystick descriptors + -> Affection [SDL.Joystick] -- ^ Returns altered list of Joystick descriptors joystickAutoDisconnect js (MsgJoystickDevice _ which SDL.JoyDeviceRemoved) = liftIO $ do joyIds <- mapM SDL.getJoystickID js diff --git a/src/Affection/Subsystems/AffectionKeyboard.hs b/src/Affection/Subsystems/AffectionKeyboard.hs index c2a1b58..a78ccda 100644 --- a/src/Affection/Subsystems/AffectionKeyboard.hs +++ b/src/Affection/Subsystems/AffectionKeyboard.hs @@ -13,10 +13,10 @@ import qualified SDL -- | Helper function that consumes all Keyboard-related 'SDL.EventPayload's -- and emits appropriate 'KeyboardMessage's consumeSDLKeyboardEvents - :: forall ak us. (Participant ak us, Mesg ak us ~ KeyboardMessage) + :: forall ak. (Participant ak, Mesg ak ~ KeyboardMessage) => ak -- ^ The message system participant -> [SDL.EventPayload] -- ^ Incoming events - -> Affection us [SDL.EventPayload] -- ^ Leftover SDL Events + -> Affection [SDL.EventPayload] -- ^ Leftover SDL Events consumeSDLKeyboardEvents ak = doConsume where doConsume [] = return [] diff --git a/src/Affection/Subsystems/AffectionMouse.hs b/src/Affection/Subsystems/AffectionMouse.hs index 01861f3..6f6a599 100644 --- a/src/Affection/Subsystems/AffectionMouse.hs +++ b/src/Affection/Subsystems/AffectionMouse.hs @@ -15,15 +15,15 @@ import qualified SDL -- | Helper funtion that consumes all Mouse-related 'SDL.Eventpayload's -- and emits appropriate 'MouseMessage's consumeSDLMouseEvents - :: forall am us. (Participant am us, Mesg am us ~ MouseMessage) + :: forall am. (Participant am, Mesg am ~ MouseMessage) => am -- ^ The message system participant -> [SDL.EventPayload] -- ^ Incoming events - -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events + -> Affection [SDL.EventPayload] -- ^ Leftover SDL events consumeSDLMouseEvents am = doConsume where doConsume :: [SDL.EventPayload] - -> Affection us [SDL.EventPayload] + -> Affection [SDL.EventPayload] doConsume [] = return [] doConsume (e:es) = do ts <- getElapsedTime diff --git a/src/Affection/Subsystems/AffectionWindow.hs b/src/Affection/Subsystems/AffectionWindow.hs index a9c2622..f59e00c 100644 --- a/src/Affection/Subsystems/AffectionWindow.hs +++ b/src/Affection/Subsystems/AffectionWindow.hs @@ -15,16 +15,16 @@ import qualified SDL -- | Helper function that consumes all Window-related 'SDL.EventPayload's -- and emits appropriate 'WindowMessage's. consumeSDLWindowEvents - :: forall aw us. (Participant aw us, Mesg aw us ~ WindowMessage) + :: forall aw. (Participant aw, Mesg aw ~ WindowMessage) => aw -- ^ The message system participant -> [SDL.EventPayload] -- ^ Incoming events - -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events + -> Affection [SDL.EventPayload] -- ^ Leftover SDL events consumeSDLWindowEvents aw = doConsume where doConsume - :: (Mesg aw us ~ WindowMessage) + :: (Mesg aw ~ WindowMessage) => [SDL.EventPayload] - -> Affection us [SDL.EventPayload] + -> Affection [SDL.EventPayload] doConsume [] = return [] doConsume (e:es) = do ts <- getElapsedTime diff --git a/src/Affection/Subsystems/Class.hs b/src/Affection/Subsystems/Class.hs index d9504c5..f004eee 100644 --- a/src/Affection/Subsystems/Class.hs +++ b/src/Affection/Subsystems/Class.hs @@ -10,4 +10,4 @@ import qualified SDL class SDLSubsystem s us where -- | Consume the given 'SDL.EventPayload's and return only those not -- recognised - consumeSDLEvents :: s -> [SDL.EventPayload] -> Affection us [SDL.EventPayload] + consumeSDLEvents :: s -> [SDL.EventPayload] -> Affection [SDL.EventPayload] diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs index f883a3d..949315c 100644 --- a/src/Affection/Types.hs +++ b/src/Affection/Types.hs @@ -49,7 +49,7 @@ data InitComponents | Only [SDL.InitFlag] -- | Main type for defining the look, feel and action of the whole application. -data AffectionData us = AffectionData +data AffectionData = AffectionData { drawWindows :: [ ( Word -- --^ Window identifier @@ -80,6 +80,6 @@ newtype AffectionState sd m a = AffectionState instance MP.MonadParallel m => MP.MonadParallel (AffectionState sd m) -type Affection us a = AffectionState (AffectionData us) IO a +type Affection a = AffectionState AffectionData IO a type Angle = Double diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs index 8fb64fa..04d68ff 100644 --- a/src/Affection/Util.hs +++ b/src/Affection/Util.hs @@ -15,7 +15,7 @@ import Data.String (fromString) import Control.Monad.State -- | Prehandle SDL events -preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload] +preHandleEvents :: [SDL.Event] -> Affection [SDL.EventPayload] preHandleEvents evs = return $ map SDL.eventPayload evs @@ -26,16 +26,16 @@ delaySec delaySec dur = SDL.delay (fromIntegral $ dur * 1000) -- | Get time since start but always the same in the current tick. -getElapsedTime :: Affection us Double +getElapsedTime :: Affection Double getElapsedTime = gets elapsedTime -- | Get delta time (time elapsed from last frame) -getDelta :: Affection us Double +getDelta :: Affection Double getDelta = gets deltaTime -- | Toggle the Screen mode between 'SDL.Windowed' and 'SDL.FullscreenDesktop'. -- Pauses the Engine in the process. -toggleScreen :: Affection us () +toggleScreen :: Affection () toggleScreen = do ad <- get newMode <- case screenMode ad of @@ -59,7 +59,7 @@ fitViewport :: Double -- ^ Image Ratio (width / height) -> WindowMessage -- ^ Incoming Message. Listens only on -- 'MsgWindowResize' and ignores all others. - -> Affection us () + -> Affection () fitViewport ratio (MsgWindowResize _ _ (SDL.V2 w h)) = do liftIO $ logIO Verbose "Fitting Viewport to size" if (fromIntegral w / fromIntegral h) > ratio