pre-release cleanup part II

shell.nix

@@ -25,9 +25,31 @@ let
       license = stdenv.lib.licenses.isc;
     }) {};
 
+  sdl2Nek0 = with haskellPackages; callPackage(
+    { mkDerivation, base, bytestring, deepseq, exceptions, linear, SDL2
+    , StateVar, stdenv, text, transformers, vector, weigh
+    }:
+    mkDerivation {
+      pname = "sdl2";
+      version = "2.4.1.0";
+      sha256 = "21a569c0c19f8ff2bbe1cf1d3eb32f65e8143806de353cedd240df5e9d088b5c";
+      isLibrary = true;
+      isExecutable = true;
+      enableSeparateDataOutput = true;
+      libraryHaskellDepends = [
+        base bytestring exceptions linear StateVar text transformers vector
+      ];
+      librarySystemDepends = [ SDL2 ];
+      libraryPkgconfigDepends = [ SDL2 ];
+      testHaskellDepends = [ base deepseq linear vector weigh ];
+      doCheck = false;
+      description = "Both high- and low-level bindings to the SDL library (version 2.0.4+).";
+      license = stdenv.lib.licenses.bsd3;
+    }) {};
+
   f = { mkDerivation, base, bytestring, clock, containers, deepseq
       , glib, linear, matrix, monad-loops, monad-parallel, mtl
-      , OpenGL, random, sdl2, stdenv, stm, text, uuid, vector
+      , OpenGL, random, stdenv, stm, text, uuid, vector
       }:
       mkDerivation {
         pname = "affection";
@@ -38,10 +60,10 @@ let
         isExecutable = true;
         libraryHaskellDepends = [
           base bytestring clock containers glib linear monad-loops
-          monad-parallel mtl OpenGL sdl2 stm text uuid vector
+          monad-parallel mtl OpenGL sdl2Nek0 stm text uuid vector
         ];
         executableHaskellDepends = [
-          base containers deepseq linear matrix nanovgNeko OpenGL random sdl2 stm
+          base containers deepseq linear matrix nanovgNeko OpenGL random sdl2Nek0 stm
         ];
         homepage = "https://github.com/nek0/affection#readme";
         description = "A simple Game Engine using SDL";

src/Affection.hs

@@ -59,32 +59,6 @@ withAffection AffectionConfig{..} = do
   liftIO $ logIO Debug "Creating Window"
   window <- SDL.createWindow windowTitle windowConfig
   SDL.showWindow window
-  -- renderer <- SDL.createRenderer
-  --   window (-1)
-  --   SDL.defaultRenderer
-  --     { SDL.rendererTargetTexture = True
-  --     }
-  -- surface <- SDL.createRGBSurface
-  --   (case canvasSize of
-  --     Just (cw, ch) -> SDL.V2
-  --       (CInt $ fromIntegral cw)
-  --       (CInt $ fromIntegral ch)
-  --     Nothing ->
-  --       SDL.windowInitialSize windowConfig
-  --   )
-  --   SDL.RGBA8888
-  -- texture <- SDL.createTexture
-  --   renderer
-  --   SDL.RGBA8888
-  --   SDL.TextureAccessTarget
-  --   (case canvasSize of
-  --     Just (cw, ch) -> SDL.V2
-  --       (CInt $ fromIntegral cw)
-  --       (CInt $ fromIntegral ch)
-  --     Nothing ->
-  --       SDL.windowInitialSize windowConfig
-  --   )
-  -- SDL.rendererRenderTarget renderer $= Just texture
   _ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
   context <- SDL.glCreateContext window
   let SDL.V2 (CInt rw) (CInt rh) = SDL.windowInitialSize windowConfig
@@ -92,7 +66,7 @@ withAffection AffectionConfig{..} = do
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (fromIntegral rw, fromIntegral rh)
   SDL.setWindowMode window initScreenMode
-  SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
+  -- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
   liftIO $ logIO Debug "Getting Time"
   -- get current time
   execTime <- getTime Monotonic
@@ -134,7 +108,7 @@ withAffection AffectionConfig{..} = do
           }
         -- poll events
         evs <- preHandleEvents =<< liftIO SDL.pollEvents
-        -- mapM_ eventLoop evs
+        -- handle events
         eventLoop evs
         -- execute user defined update loop
         unless (pausedTime ad) (updateLoop dt)
@@ -142,12 +116,8 @@ withAffection AffectionConfig{..} = do
         liftIO $ GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
         drawLoop
         liftIO GL.flush
-        -- handle all new draw requests
+        -- actual displaying of newly drawn frame
-        ad2 <- get
-        -- actual drawing
         SDL.glSwapWindow window
-        -- SDL.copy renderer texture Nothing Nothing
-        -- SDL.present renderer
         -- save new time
         ad3 <- get
         when (sysTime ad == sysTime ad3) (
@@ -162,5 +132,5 @@ withAffection AffectionConfig{..} = do
   liftIO $ logIO Debug "Destroying Window"
   SDL.glDeleteContext context
   SDL.destroyWindow window
-  -- SDL.quit
+  -- SDL.quit -- <- This causes segfaults depending on hardware
   liftIO $ logIO Debug "This is the end"

src/Affection/Logging.hs

@@ -1,15 +1,23 @@
 {-# LANGUAGE CPP #-}
 module Affection.Logging where
+-- ^ This module defines the logging capability of Affection, whis is derived
+-- from "Debug.Trace".
 
 import Debug.Trace
 
+-- | The log level definition
 data LogLevel
-  = Verbose
+  = Verbose -- ^ Log everything
-  | Debug
+  | Debug   -- ^ Log Debug messages and above
-  | Warn
+  | Warn    -- ^ Log only Warnings and errors
-  | Error
+  | Error   -- ^ Log only errors
 
-log :: LogLevel -> String -> a -> a
+-- | Pure logging function
+log
+  :: LogLevel -- ^ Log level to log to
+  -> String   -- ^ The message string
+  -> a        -- ^ Arbitrary datatype to return
+  -> a        -- ^ Returned data
 #if defined(VERBOSE)
 log Verbose s = trace ("VERBOSE: " ++ s)
 #endif
@@ -24,7 +32,11 @@ log Error s = trace ("ERROR: " ++ s)
 #endif
 log _ _ = id
 
-logIO :: LogLevel -> String -> IO ()
+-- | Manadic logging function residing in the 'IO' Monad
+logIO
+  :: LogLevel -- ^ Log level to log to
+  -> String   -- ^ The message string
+  -> IO ()
 #if defined(VERBOSE)
 logIO Verbose s = traceIO ("VERBOSE: " ++ s)
 #endif

src/Affection/MessageBus/Class.hs

@@ -3,11 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ExistentialQuantification #-}
-module Affection.MessageBus.Class 
+module Affection.MessageBus.Class where
-  ( Participant(..)
-  , genUUID
-  , UUID
-  ) where
 
 import Affection.MessageBus.Message
 import Affection.Types
@@ -19,8 +15,9 @@ import Data.UUID.V4
 
 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
-  type Mesg prt us :: *
+  type Mesg prt us :: * -- ^ Message datatype
 
   -- | Function to get the list of subscribers from the participant
   partSubscribers

src/Affection/MessageBus/Message/Class.hs

@@ -1,6 +1,6 @@
 module Affection.MessageBus.Message.Class where
 
-import Data.Word (Word32(..))
+-- | Typeclass definition for messages
-
 class Message msg where
+  -- | return the time when the message was sent
   msgTime :: msg -> Double

src/Affection/MessageBus/Message/JoystickMessage.hs

@@ -1,7 +1,8 @@
 module Affection.MessageBus.Message.JoystickMessage 
   ( JoystickMessage(..)
+    -- | Vector export
+  , Linear.V2
     -- | SDL exports
-  , SDL.V2
   , SDL.JoyHatPosition
   , SDL.JoyButtonState
   , SDL.JoyDeviceConnection
@@ -20,41 +21,42 @@ import qualified SDL
 
 import Linear (V2(..))
 
+-- Datatype for handling all possible joystick events handed over from sdl2
 data JoystickMessage
-  = MsgJoystickAxis
+  = MsgJoystickAxis -- ^ Movement of a Joystick axis
-    { msgJAWhen :: Double
+    { msgJAWhen :: Double -- ^ Time of event
-    , msgJAWhich :: Int32
+    , msgJAWhich :: Int32 -- ^ Joystick identifier
-    , msgJAAxis :: Word8
+    , msgJAAxis :: Word8  -- ^ Axis identifier
-    , msgJAValue :: Int16
+    , msgJAValue :: Int16 -- ^ Axis value
     }
-  | MsgJoystickBall
+  | MsgJoystickBall -- ^ Movement of a joystick ball controller
-    { msgJBWhen :: Double
+    { msgJBWhen :: Double            -- ^ Time of event
-    , msgJBWhich :: Int32
+    , msgJBWhich :: Int32            -- ^ Joystick identifier
-    , msgJBBall :: Word8
+    , msgJBBall :: Word8             -- ^ Ball identifier
-    , msgJBRelMotion :: SDL.V2 Int16
+    , msgJBRelMotion :: V2 Int16     -- ^ Motion relative to previous position
     }
-  | MsgJoystickHat
+  | MsgJoystickHat -- ^ Movement of joystick hat controller
-    { msgJHWhen :: Double
+    { msgJHWhen :: Double                 -- Time of event
-    , msgJHWhich :: Int32
+    , msgJHWhich :: Int32                 -- Joystick identifier
-    , msgJHHat :: Word8
+    , msgJHHat :: Word8                   -- Hat identifier
-    , msgJHPosition :: SDL.JoyHatPosition
+    , msgJHPosition :: SDL.JoyHatPosition -- New hat position
     }
-  | MsgJoystickButton
+  | MsgJoystickButton -- ^ Joystick button event
-    { msgJBWhen :: Double
+    { msgJBWhen :: Double              -- Time of event
-    , msgJBWhich :: Int32
+    , msgJBWhich :: Int32              -- Joystick identifier
-    , msgJBButton :: Word8
+    , msgJBButton :: Word8             -- Button identifier
-    , msgJBState :: SDL.JoyButtonState
+    , msgJBState :: SDL.JoyButtonState -- New Button state
     }
-  | MsgJoystickDevice
+  | MsgJoystickDevice -- ^ Joystick device event
-    { msgJDWhen :: Double
+    { msgJDWhen :: Double                        -- Time of event
-    , msgJDWhich :: Int32
+    , msgJDWhich :: Int32                        -- Joystick identifier
-    , msgJDConnection :: SDL.JoyDeviceConnection
+    , msgJDConnection :: SDL.JoyDeviceConnection -- Connection status
     }
   deriving (Show)
 
 instance Message JoystickMessage where
-  msgTime (MsgJoystickAxis t _ _ _) = t
+  msgTime (MsgJoystickAxis t _ _ _)   = t
-  msgTime (MsgJoystickBall t _ _ _) = t
+  msgTime (MsgJoystickBall t _ _ _)   = t
-  msgTime (MsgJoystickHat t _ _ _) = t
+  msgTime (MsgJoystickHat t _ _ _)    = t
   msgTime (MsgJoystickButton t _ _ _) = t
-  msgTime (MsgJoystickDevice t _ _) = t
+  msgTime (MsgJoystickDevice t _ _)   = t

src/Affection/MessageBus/Message/KeyboardMessage.hs

@@ -1,16 +1,23 @@
-module Affection.MessageBus.Message.KeyboardMessage where
+module Affection.MessageBus.Message.KeyboardMessage 
+  ( KeyboardMessage(..)
+  -- | SDL reexports
+  , SDL.Window
+  , SDL.InputMotion
+  , SDL.Keysym
+  ) where
 
 import Affection.MessageBus.Message.Class
 
 import qualified SDL
 
+-- | Dataatype for handling all keyboard events haded down from SDL2
 data KeyboardMessage
-  = MsgKeyboardEvent
+  = MsgKeyboardEvent                     -- ^ Arbitrary Keyboard event
-    { msgKbdWhen :: Double
+    { msgKbdWhen :: Double               -- ^ Message time
-    , msgKbdWindow :: Maybe SDL.Window
+    , msgKbdWindow :: Maybe SDL.Window   -- ^ Affected Window
-    , msgKbdKeyMotion :: SDL.InputMotion
+    , msgKbdKeyMotion :: SDL.InputMotion -- ^ Input motion of button (pressed/released)
-    , msgKbdKeyRepeat :: Bool
+    , msgKbdKeyRepeat :: Bool            -- ^ Is this a repeated event?
-    , msgKbdKeysym :: SDL.Keysym
+    , msgKbdKeysym :: SDL.Keysym         -- ^ The button's 'SDL.Keysym'
     }
   deriving (Show)
 

src/Affection/MessageBus/Message/MouseMessage.hs

@@ -1,4 +1,12 @@
-module Affection.MessageBus.Message.MouseMessage where
+module Affection.MessageBus.Message.MouseMessage
+  ( MouseMessage(..)
+  -- | SDL reexports
+  , SDL.Window
+  , SDL.MouseDevice
+  , SDL.MouseButton
+  , SDL.InputMotion
+  , SDL.MouseScrollDirection
+  ) where
 
 import Affection.MessageBus.Message.Class
 
@@ -9,30 +17,31 @@ import qualified SDL
 
 import Linear (V2(..))
 
+-- Datatype for handling mouse events handed down from SDL2
 data MouseMessage
-  = MsgMouseMotion
+  = MsgMouseMotion -- ^ Mouse motion event
-    { msgMMWhen :: Double
+    { msgMMWhen :: Double             -- ^ Message time
-    , msgMMWindow :: Maybe SDL.Window
+    , msgMMWindow :: Maybe SDL.Window -- ^ Focused window (if any)
-    , msgMMWhich :: SDL.MouseDevice
+    , msgMMWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
-    , msgMMState :: [SDL.MouseButton]
+    , msgMMState :: [SDL.MouseButton] -- ^ List of pressed mouse buttons
-    , msgMMPos :: V2 Int32
+    , msgMMPos :: V2 Int32            -- ^ Absolute mouse positiom
-    , msgMMRelMotion :: V2 Int32
+    , msgMMRelMotion :: V2 Int32      -- ^ Mouse movement relative to previous position
     }
-  | MsgMouseButton
+  | MsgMouseButton -- ^ Mouse button event
-    { msgMBWhen :: Double
+    { msgMBWhen :: Double             -- ^ Message time
-    , msgMBWindow :: Maybe SDL.Window
+    , msgMBWindow :: Maybe SDL.Window -- ^ Focused window (if any)
-    , msgMBMotion :: SDL.InputMotion
+    , msgMBMotion :: SDL.InputMotion  -- ^ Button's input motion
-    , msgMBWhich :: SDL.MouseDevice
+    , msgMBWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
-    , msgMBButton :: SDL.MouseButton
+    , msgMBButton :: SDL.MouseButton  -- ^ Affected mouse button
-    , msgMBClicks :: Word8
+    , msgMBClicks :: Word8            -- ^ Number of clicks
-    , msgMBPos :: V2 Int32
+    , msgMBPos :: V2 Int32            -- ^ Absolute mouse position
     }
-  | MsgMouseWheel
+  | MsgMouseWheel -- ^ Mouse wheel event
-    { msgMWWhen :: Double
+    { msgMWWhen :: Double                        -- ^ Message time
-    , msgMWWhindow :: Maybe SDL.Window
+    , msgMWWhindow :: Maybe SDL.Window           -- ^ Focused window (if any)
-    , msgMWWhich :: SDL.MouseDevice
+    , msgMWWhich :: SDL.MouseDevice              -- ^ Mouse device identifier
-    , msgMWPos :: V2 Int32
+    , msgMWPos :: V2 Int32                       -- ^ Absolute mouse position
-    , msgMWDIrection :: SDL.MouseScrollDirection
+    , msgMWDIrection :: SDL.MouseScrollDirection -- ^ Scroll direction
     }
   deriving (Show)
 

src/Affection/MessageBus/Message/WindowMessage.hs

@@ -1,4 +1,8 @@
-module Affection.MessageBus.Message.WindowMessage where
+module Affection.MessageBus.Message.WindowMessage
+  ( WindowMessage(..)
+  -- | SDL reexports
+  , SDL.Window
+  ) where
 
 import Affection.MessageBus.Message.Class
 
@@ -8,66 +12,66 @@ import qualified SDL
 
 import Linear (V2(..))
 
+-- | Datatype for handling Window events handed down rom SDL2
 data WindowMessage
-  -- = MsgEngineReady Double
+  = MsgWindowShow -- ^ Window show event
-  = MsgWindowShow
+    { msgWSWhen :: Double       -- ^ Message time
-    { msgWSWhen :: Double
+    , msgWSWindow :: SDL.Window -- ^ Window identifier
-    , msgWSWindow :: SDL.Window
     }
-  | MsgWindowHide
+  | MsgWindowHide -- ^ Window hide event
-    { msgWHWhen :: Double
+    { msgWHWhen :: Double       -- ^ Message time
-    , msgWHWindow :: SDL.Window
+    , msgWHWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowExpose
+  | MsgWindowExpose -- ^ Window expose event
-    { msgWEWhen :: Double
+    { msgWEWhen :: Double       -- ^ Message time
-    , msgWEWindow :: SDL.Window
+    , msgWEWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowMove
+  | MsgWindowMove -- ^ Window move event
-    { msgWMWhen :: Double
+    { msgWMWhen :: Double       -- ^ Message time
-    , msgWMWindow :: SDL.Window
+    , msgWMWindow :: SDL.Window -- ^ Window identifier
-    , msgWMNewPos :: V2 Int32
+    , msgWMNewPos :: V2 Int32   -- ^ New absolute window position
     }
-  | MsgWindowResize
+  | MsgWindowResize -- ^ Window resize event
-    { msgWRWhen :: Double
+    { msgWRWhen :: Double       -- ^ Message time
-    , msgWRWindow :: SDL.Window
+    , msgWRWindow :: SDL.Window -- ^ Window identifier
-    , msgWRNewSize :: V2 Int32
+    , msgWRNewSize :: V2 Int32  -- ^ New absolute window size
     }
-  | MsgWindowSizeChange
+  | MsgWindowSizeChange -- ^ Window size change event
-    { msgWSCWhen :: Double
+    { msgWSCWhen :: Double       -- ^ Message time
-    , msgWSCWindow :: SDL.Window
+    , msgWSCWindow :: SDL.Window -- ^ Window identifier
-    , msgWRNewSize :: V2 Int32
+    , msgWSCNewSize :: V2 Int32  -- ^ New absolute window size
     }
-  | MsgWindowMinimize
+  | MsgWindowMinimize -- ^ Window minimize event
-    { msgWMinWhen :: Double
+    { msgWMinWhen :: Double       -- ^ Message time
-    , msgWMinWindow :: SDL.Window
+    , msgWMinWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowMaximize
+  | MsgWindowMaximize -- ^ Window maximize event
-    { msgWMaxWhen :: Double
+    { msgWMaxWhen :: Double       -- ^ Message time
-    , msgWMaxWindow :: SDL.Window
+    , msgWMaxWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowRestore
+  | MsgWindowRestore -- ^ Window restore event
-    { msgWRestWhen :: Double
+    { msgWRestWhen :: Double       -- ^ Message time
-    , msgWRestWindow :: SDL.Window
+    , msgWRestWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowGainMouseFocus
+  | MsgWindowGainMouseFocus -- ^ Window gain mouse focus event
-    { msgWGMFWhen :: Double
+    { msgWGMFWhen :: Double       -- ^ Message Time
-    , msgWGMFWindow :: SDL.Window
+    , msgWGMFWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowLoseMouseFocus
+  | MsgWindowLoseMouseFocus -- ^ Window lose mouse focus event
-    { msgWLMFWhen :: Double
+    { msgWLMFWhen :: Double       -- ^ Message Time
-    , msgWLMFWindow :: SDL.Window
+    , msgWLMFWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowGainKeyboardFocus
+  | MsgWindowGainKeyboardFocus -- ^ Window gain keyboard focus event
-    { msgWGKFWhen :: Double
+    { msgWGKFWhen :: Double       -- ^ Message time
-    , msgWGKFWindow :: SDL.Window
+    , msgWGKFWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowLoseKeyboardFocus
+  | MsgWindowLoseKeyboardFocus -- ^ Window lose keyboard focus event
-    { msgWLKFWhen :: Double
+    { msgWLKFWhen :: Double       -- ^ Message time
-    , msgWLKFWindow :: SDL.Window
+    , msgWLKFWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowClose
+  | MsgWindowClose -- ^ Window close event
-    { msgWCWhen :: Double
+    { msgWCWhen :: Double       -- ^ Message time
-    , msgWCWindow :: SDL.Window
+    , msgWCWindow :: SDL.Window -- ^ Window identifier
     }
   deriving (Show)
 

src/Affection/MessageBus/Util.hs

@@ -1,3 +0,0 @@
-module Affection.MessageBus.Util where
-
--- zuru zuru

src/Affection/MouseInteractable.hs

@@ -1,42 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Affection.MouseInteractable where
-
-import Affection.Types
-
-import qualified SDL
-
--- class MouseHoverable a us where
---   onHover :: a -> Affection us ()
-
--- | Define a mouse clickable object
-class MouseClickable a us where
-  onClick
-    :: a               -- The object
-    -> SDL.MouseButton -- The clicked button
-    -> (Int, Int)      -- The coordinates of the click
-    -> SDL.InputMotion -- The 'SDL.InputMotion' of the click
-    -> Int             -- The number of clicks
-    -> Affection us ()
-
--- | A helper function that checks wether provided clickables have been clicked.
--- This function does not consume provided events, but passes them on.
-handleMouseClicks
-  :: (Foldable t, MouseClickable clickable us)
-  => SDL.EventPayload              -- ^ Piped event in
-  -> t clickable                   -- ^ 'MouseClickable' elemt to be checked
-  -> Affection us SDL.EventPayload -- ^ Unaltered event
-handleMouseClicks e clickables =
-  case e of
-    SDL.MouseButtonEvent dat -> do
-      mapM_ (\clickable -> do
-        let SDL.P (SDL.V2 x y) = SDL.mouseButtonEventPos dat
-        onClick
-          clickable
-          (SDL.mouseButtonEventButton dat)
-          (fromIntegral x, fromIntegral y)
-          (SDL.mouseButtonEventMotion dat)
-          (fromIntegral $ SDL.mouseButtonEventClicks dat)
-        ) clickables
-      return e
-    _ -> return e

src/Affection/StateMachine.hs

@@ -6,9 +6,15 @@ import Affection.Types
 
 import qualified SDL
 
+-- | Typeclass for simple scaffolding of a state machine
 class StateMachine a us where
+  -- | State load routine
   smLoad   :: a -> Affection us ()
+  -- | state update routine
   smUpdate :: a -> Double -> Affection us ()
+  -- | State event handler routine
   smEvent  :: a -> [SDL.EventPayload] -> Affection us ()
+  -- | State draw routine
   smDraw   :: a -> Affection us ()
+  -- | State clean routine
   smClean  :: a -> Affection us ()

src/Affection/Subsystems/AffectionJoystick.hs

@@ -77,7 +77,13 @@ consumeSDLJoystickEvents am = doConsume
           doConsume es
         _ -> fmap (e :) (doConsume es)
 
-joystickAutoConnect :: JoystickMessage -> Affection us (Maybe SDL.Joystick)
+-- | Helper function to automatically connect and open newly attached joystick
+-- devices
+joystickAutoConnect
+  :: JoystickMessage -- ^ Any 'JoystickMessage' will do,
+  -- but listens only on 'MsgJoystickDevice' messages
+  -> Affection us (Maybe SDL.Joystick)
+  -- ^ Returns a joystick descriptor, if successful
 joystickAutoConnect (MsgJoystickDevice _ which SDL.JoyDeviceAdded) = liftIO $ do
   [descr] <- V.toList <$>
     (return . V.filter (\(SDL.JoystickDevice _ id) -> id == CInt which)
@@ -86,7 +92,13 @@ joystickAutoConnect (MsgJoystickDevice _ which SDL.JoyDeviceAdded) = liftIO $ do
   Just <$> SDL.openJoystick descr
 joystickAutoConnect _ = return Nothing
 
-joystickAutoDisconnect :: [SDL.Joystick] -> JoystickMessage -> Affection us [SDL.Joystick]
+-- | Helper function to automatically close and disconnect freshly detached
+-- joystick devices
+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
 joystickAutoDisconnect js (MsgJoystickDevice _ which SDL.JoyDeviceRemoved) =
   liftIO $ do
     joyIds <- mapM SDL.getJoystickID js

src/Affection/Types.hs

@@ -1,34 +1,20 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
 module Affection.Types 
-  -- ( Affection
+  ( Affection(..)
-  -- , AffectionData(..)
+  , AffectionConfig(..)
-  -- , AffectionConfig(..)
+  , AffectionData(..)
-  -- , AffectionState(..)
+  , AffectionStateInner(..)
-  -- -- , AffectionDraw(..)
+  , AffectionState(..)
-  -- -- , Draw(..)
+  , InitComponents(..)
-  -- , AffectionStateInner
+  , Angle(..)
-  -- -- , AffectionDrawInner(..)
+  -- | SDL reexports
-  -- , InitComponents(..)
+  , SDL.WindowConfig(..)
-  -- -- , Loop(..)
+  , SDL.WindowMode(..)
-  -- -- , RGBA(..)
+  , SDL.EventPayload(..)
-  -- , DrawType(..)
+  , SDL.InitFlags(..)
-  -- , DrawRequest(..)
+  , SDL.Window(..)
-  -- , RequestPersist(..)
+  , SDL.GLContext(..)
-  -- , Angle(..)
+  ) where
-  -- -- , ConvertAngle(..)
-  --   -- | Particle system
-  -- , Particle(..)
-  -- , ParticleSystem(..)
-  -- , ParticleStorage(..)
-  --   -- | Convenience exports
-  -- , liftIO
-  -- , SDL.WindowConfig(..)
-  -- , SDL.defaultWindow
-  --   -- | GEGL reexports
-  -- , G.GeglRectangle(..)
-  -- , G.GeglBuffer(..)
-  -- )
-  where
 
 import qualified SDL.Init as SDL
 import qualified SDL.Video as SDL
@@ -36,17 +22,11 @@ import qualified SDL.Event as SDL
 import qualified Data.Text as T
 import Data.Map.Strict as M
 
--- import qualified GEGL as G
--- import qualified BABL as B
-
 import Control.Monad.IO.Class
 import Control.Monad.State.Strict
 import qualified Control.Monad.Parallel as MP
 
 import System.Clock (TimeSpec)
--- import Control.Monad.Reader
-
--- import Control.Concurrent.MVar
 
 import Foreign.Ptr (Ptr)
 
@@ -85,16 +65,11 @@ data InitComponents
 
 -- | Main type for defining the look, feel and action of the whole application.
 data AffectionData us = AffectionData
-  -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
   { quitEvent       :: Bool               -- ^ Loop breaker.
   , userState       :: us                 -- ^ State data provided by user
   , drawWindow      :: SDL.Window         -- ^ SDL window
   , glContext       :: SDL.GLContext      -- ^ OpenGL rendering context
-  , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window
-  , drawTexture     :: SDL.Texture        -- ^ SDL Texture to draw to
-  -- , drawFormat      :: B.BablFormatPtr    -- ^ Target format
   , screenMode      :: SDL.WindowMode     -- ^ current screen mode
-  -- , drawStack       :: [DrawRequest]      -- ^ Stack of 'DrawRequest's to be processed
   , drawDimensions  :: (Int, Int)         -- ^ Dimensions of target surface
   , drawStride      :: Int                -- ^ Stride of target buffer
   , drawCPP         :: Int                -- ^ Number of components per pixel
@@ -102,25 +77,9 @@ data AffectionData us = AffectionData
   , deltaTime       :: Double             -- ^ Elapsed time in seconds since last tick
   , sysTime         :: TimeSpec           -- ^ System time (NOT the time on the clock)
   , pausedTime      :: Bool               -- ^ Should the update loop be executed?
-  -- , messageChannel  :: Channel msg        -- ^ The main broadcast channel to duplicate all others from
   }
 
--- -- | This datatype stores information about areas of a 'G.GeglBuffer' to be updated
--- data DrawRequest = DrawRequest
---   { requestArea     :: G.GeglRectangle -- ^ The area to update
---   , requestBuffer   :: G.GeglBuffer    -- ^ Buffer to draw
---   , requestPersist  :: RequestPersist  -- ^ Shall the drawRequest persist
---   }
--- 
--- data RequestPersist
---   = Persist
---   | Kill (Maybe G.GeglNode)
--- 
--- -- | A type for storing 'DrawRequest' results to be executed frequently. TODO
--- data DrawAsset = DrawAsset
-
 -- | Inner 'StateT' monad for the update state
--- type AffectionStateInner us m a = StateT (AffectionData us) m a
 type AffectionStateInner us a = StateT us a
 
 -- | Affection's state monad
@@ -132,102 +91,4 @@ instance MP.MonadParallel m => MP.MonadParallel (AffectionState us m)
 
 type Affection us a = AffectionState (AffectionData us) IO a
 
--- -- | Inner 'StateT' monad of Affection
--- type AffectionInner us od a = StateT (AffectionState us od) IO a
--- 
--- -- | Affection state monad
--- newtype Affection us od a = Affection
---   { runAffection :: AffectionInner us od a }
---   deriving (Functor, Applicative, Monad, MonadState (AffectionState us od))
--- 
--- -- | Inner drawing monad of Affection.
--- type AffectionDrawInner ds a = ReaderT (Draw ds) a
--- 
--- -- | Affectiondrawinf reader monad.
--- newtype AffectionDraw ds a = AffectionDraw
---   { runDraw :: (ds -> a) }
---   deriving (Functor, Applicative, Monad, MonadReader ds)
--- 
--- -- | Loop state monad to hold elapsed time per frame
--- newtype Loop f a = Loop
---   { runLoop :: f -> (a, f) }
---   deriving (Functor, Applicative, Monad, MonadState (Loop f))
-
--- data RGBA = RGBA
---   { r :: Int
---   , g :: Int
---   , b :: Int
---   , a :: Int
---   }
-
--- | Type for defining the draw type of draw functions
-data DrawType
-    -- | Fill the specified area completely with color
-  = Fill
-    -- | only draw the outline of the area
-  | Line
-    { lineWidth :: Int -- ^ Width of line in pixels
-    }
-
 type Angle = Double
-
--- -- | Type for defining angles
--- data Angle
---   = Rad Double -- ^ Angle in radians
---   | Deg Double -- ^ Angle in degrees
---   deriving (Show)
--- 
--- -- | Typeclass for converting Angles from 'Deg' to 'Rad' and vice versa.
--- class ConvertAngle a where
---   toRad :: a -> a -- Convert to 'Rad'
---   toDeg :: a -> a -- Convert to 'Deg'
--- 
--- instance ConvertAngle Angle where
---   toRad (Deg x) = Rad $ x * pi / 180
---   toRad x = x
--- 
---   toDeg (Rad x) = Deg $ x * 180 / pi
---   toDeg x = x
--- 
--- instance Eq Angle where
---   (==) (Deg x) (Deg y) = x == y
---   (==) (Rad x) (Rad y) = x == y
---   (==) dx@(Deg _) ry@(Rad _) = dx == toDeg ry
---   (==) rx@(Rad _) dy@(Deg _) = toDeg rx == dy
-
--- -- | A single particle
--- data Particle = Particle
---   { particleTimeToLive :: Double
---       -- ^ Time to live in seconds
---   , particleCreation   :: Double
---       -- ^ Creation time of particle in seconds form program start
---   , particlePosition   :: (Double, Double)
---       -- ^ Position of particle on canvas
---   , particleRotation   :: Angle
---       -- ^ Particle rotation
---   , particleVelocity   :: (Int, Int)
---       -- ^ particle velocity as vector of pixels per second
---   , particlePitchRate  :: Angle
---       -- ^ Rotational velocity of particle in angle per second
---   , particleRootNode   :: G.GeglNode
---       -- ^ Root 'G.GeglNode' of 'Particle'
---   , particleNodeGraph  :: Map String G.GeglNode
---       -- ^ Node Graph of 'G.GeglNodes' per particle
---   , particleStackCont  :: G.GeglNode
---       -- ^ 'G.GeglNode' to connect other 'Particle's to
---   , particleDrawFlange :: G.GeglNode
---       -- ^ 'G.GeglNode' to connect draw actions to
---   } deriving (Eq)
--- 
--- -- | The particle system
--- data ParticleSystem = ParticleSystem
---   { partSysParts  :: ParticleStorage
---   , partSysNode   :: G.GeglNode
---   , partSysBuffer :: G.GeglBuffer
---   }
--- 
--- -- | The particle storage datatype
--- data ParticleStorage = ParticleStorage
---   { partStorLatest :: Maybe Particle -- ^ The particle stored last
---   , partStorList   :: [Particle]     -- ^ List of particles in ascending order of remaining lifetime
---   }