diff --git a/affection.cabal b/affection.cabal
--- a/affection.cabal
+++ b/affection.cabal
@@ -6,7 +6,7 @@
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.0.0.7
+version:             0.0.0.9
 synopsis:            A simple Game Engine using SDL
 description:         This package contains Affection, a simple game engine
                      written in Haskell using SDL.
@@ -68,21 +68,21 @@
                      , Affection.Logging
                      , Affection.Types
                      , Affection.StateMachine
-                     , Affection.MouseInteractable
                      , Affection.Util
                      , Affection.MessageBus
-                     , Affection.MessageBus.Util
                      , Affection.MessageBus.Class
                      , Affection.MessageBus.Message
                      , Affection.MessageBus.Message.Class
                      , Affection.MessageBus.Message.WindowMessage
                      , Affection.MessageBus.Message.KeyboardMessage
                      , Affection.MessageBus.Message.MouseMessage
+                     , Affection.MessageBus.Message.JoystickMessage
                      , Affection.Subsystems
                      , Affection.Subsystems.Class
                      , Affection.Subsystems.AffectionWindow
                      , Affection.Subsystems.AffectionKeyboard
                      , Affection.Subsystems.AffectionMouse
+                     , Affection.Subsystems.AffectionJoystick
   default-extensions:  OverloadedStrings
 
   -- Modules included in this library but not exported.
@@ -99,7 +99,7 @@
   ghc-options:       -Wall
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.9 && < 5
-                     , sdl2
+                     , sdl2 >= 2.4 && < 2.5
                      , linear
                      , text
                      , mtl
@@ -112,12 +112,13 @@
                      , OpenGL
                      , stm
                      , uuid
+                     , vector
 
 -- This example shows the message system. only makes sense when compiling with
 -- verbose flag.
 executable example00
-  hs-source-dirs:    examples
-  main-is:           example00.hs
+  hs-source-dirs:    examples/example00
+  main-is:           Main.hs
   ghc-options:       -threaded -Wall
   default-language:  Haskell2010
   default-extensions: OverloadedStrings
@@ -129,114 +130,25 @@
   else
     buildable:       False
 
--- executable example01
---   hs-source-dirs:    examples
---   main-is:           example01.hs
---   ghc-options:       -threaded -Wall
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , mtl
---   else
---     buildable:       False
--- 
--- executable example02
---   hs-source-dirs:    examples
---   main-is:           example02.hs
---   ghc-options:       -threaded -Wall
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , mtl
---                      , monad-parallel
---   else
---     buildable:       False
--- 
--- executable example02.1
---   hs-source-dirs:    examples
---   main-is:           example02.1.hs
---   ghc-options:       -threaded -Wall
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , mtl
---   else
---     buildable:       False
--- 
--- executable example03
---   hs-source-dirs:    examples
---   main-is:           example03.hs
---   ghc-options:       -threaded -Wall -auto-all -caf-all -rtsopts
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , mtl
---                      , random
---   else
---     buildable:       False
--- 
--- executable example04
---   hs-source-dirs:    examples
---   main-is:           example04.hs
---   ghc-options:       -threaded -Wall -auto-all -caf-all -rtsopts
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , mtl
---                      , random
---                      , monad-parallel
---   else
---     buildable:       False
--- 
--- executable example05
---   hs-source-dirs:    examples
---   main-is:           example05.hs
---   ghc-options:       -threaded -Wall -auto-all -caf-all -rtsopts
---   default-language:  Haskell2010
---   default-extensions: OverloadedStrings
---   if flag(examples)
---     build-depends:     base
---                      , affection
---                      , sdl2
---                      , gegl
---                      , babl
---                      , containers
---                      , unordered-containers
---                      , mtl
---                      , random
---                      , matrix
---                      , random
---                      , monad-parallel
---                      , parallel
---   else
---     buildable:       False
+-- A small game of life implementation
+executable example01
+  hs-source-dirs:    examples/example01
+  main-is:           Main.hs
+  other-modules:     Types
+  ghc-options:       -threaded -Wall
+  default-language:  Haskell2010
+  default-extensions: OverloadedStrings
+  if flag(examples)
+    build-depends:     base >=4.9 && < 5
+                     , affection
+                     , sdl2
+                     , stm
+                     , OpenGL
+                     , random
+                     , containers
+                     , linear
+                     , matrix
+                     , nanovg >= 0.6.0.0
+                     , deepseq
+  else
+    buildable:       False
diff --git a/examples/example00.hs b/examples/example00.hs
deleted file mode 100644
--- a/examples/example00.hs
+++ /dev/null
@@ -1,138 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-import Affection
-import qualified SDL
-
-import Control.Concurrent.STM
-import Control.Monad.IO.Class (liftIO)
-
-newtype StateData = StateData
-  { sdSubs :: Subsystems
-  }
-
-data Subsystems = Subsystems
-  { subWindow :: Window
-  , subMouse :: Mouse
-  , subKeyboard :: Keyboard
-  }
-
-newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())])
-newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())])
-newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())])
-
-instance Participant Window WindowMessage StateData where
-  partSubscribers (Window t) = do
-    subTups <- liftIO $ readTVarIO t
-    return $ map snd subTups
-
-  partSubscribe (Window t) funct = do
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return $ MsgId uuid MsgWindowEmptyEvent
-
-  partUnSubscribe (Window t) (MsgId uuid _) =
-    liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
-
-instance SDLSubsystem Window StateData where
-  consumeSDLEvents = consumeSDLWindowEvents
-
-instance Participant Mouse MouseMessage StateData where
-  partSubscribers (Mouse t) = do
-    subTups <- liftIO $ readTVarIO t
-    return $ map snd subTups
-
-  partSubscribe (Mouse t) funct = do
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return $ MsgId uuid MsgMouseEmptyEvent
-
-  partUnSubscribe (Mouse t) (MsgId uuid _) =
-    liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
-
-instance SDLSubsystem Mouse StateData where
-  consumeSDLEvents = consumeSDLMouseEvents
-
-instance Participant Keyboard KeyboardMessage StateData where
-  partSubscribers (Keyboard t) = do
-    subTups <- liftIO $ readTVarIO t
-    return $ map snd subTups
-
-  partSubscribe (Keyboard t) funct = do
-    uuid <- genUUID
-    liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
-    return $ MsgId uuid MsgKeyboardEmptyEvent
-
-  partUnSubscribe (Keyboard t) (MsgId uuid _) =
-    liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
-
-instance SDLSubsystem Keyboard StateData where
-  consumeSDLEvents = consumeSDLKeyboardEvents
-
-main :: IO ()
-main = do
-  logIO Debug "Starting"
-  let conf = AffectionConfig
-        { initComponents = All
-        , windowTitle = "affection: example00"
-        , windowConfig = SDL.defaultWindow
-          { SDL.windowOpenGL = Just SDL.defaultOpenGL
-            { SDL.glProfile = SDL.Core SDL.Normal 3 3
-            }
-          }
-        , initScreenMode = SDL.Windowed
-        , canvasSize = Nothing
-        , loadState = load
-        , preLoop = pre
-        , eventLoop = handle
-        , updateLoop = update
-        , drawLoop = draw
-        , cleanUp = clean
-        }
-  withAffection conf
-
-load :: IO StateData
-load = do
-  empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection StateData ())])
-  empty2 <- newTVarIO [] -- ([] :: [(UUID, MouseMessage -> Affection StateData ())])
-  empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection StateData ())])
-  return $ StateData $ Subsystems
-    (Window empty1)
-    (Mouse empty2)
-    (Keyboard empty3)
-
-pre :: Affection StateData ()
-pre = do
-  sd <- getAffection
-  _ <- partSubscribe (subKeyboard $ sdSubs sd) exitOnQ
-  _ <- partSubscribe (subWindow $ sdSubs sd) exitOnWindowClose
-  return ()
-
-exitOnQ :: KeyboardMessage -> Affection StateData ()
-exitOnQ (MsgKeyboardEvent _ _ _ _ sym) =
-  case SDL.keysymKeycode sym of
-    SDL.KeycodeQ -> do
-      liftIO $ logIO Debug "Yo dog I heard..."
-      quit
-    _ -> return ()
-
-exitOnWindowClose :: WindowMessage -> Affection StateData ()
-exitOnWindowClose wm =
-  case wm of
-    MsgWindowClose _ _ -> do
-      liftIO $ logIO Debug "I heard another one..."
-      quit
-    _ -> return ()
-
-handle :: [SDL.EventPayload] -> Affection StateData ()
-handle es = do
-  (Subsystems a b c) <- sdSubs <$> getAffection
-  _ <- consumeSDLEvents a es
-  _ <- consumeSDLEvents b es
-  _ <- consumeSDLEvents c es
-  return ()
-
-update _ = return ()
-
-draw = return ()
-
-clean _ = return ()
diff --git a/examples/example00/Main.hs b/examples/example00/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/example00/Main.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+import Affection as A
+
+import Control.Concurrent.STM
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (when)
+
+import qualified SDL hiding (Window(..))
+
+import Data.Maybe (isJust, fromJust)
+
+data StateData = StateData
+  { sdSubs :: Subsystems
+  , sdJoys :: [SDL.Joystick]
+  }
+
+data Subsystems = Subsystems
+  { subWindow   :: Main.Window
+  , subMouse    :: Main.Mouse
+  , subKeyboard :: Main.Keyboard
+  , subJoystick :: Main.Joystick
+  }
+
+newtype Window = Window (TVar [(UUID, WindowMessage -> Affection StateData ())])
+newtype Mouse = Mouse (TVar [(UUID, MouseMessage -> Affection StateData ())])
+newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection StateData ())])
+newtype Joystick = Joystick (TVar [(UUID, JoystickMessage -> Affection StateData ())])
+
+generalSubscribers
+  :: TVar [(UUID, msg -> Affection StateData ())]
+  -> Affection StateData [msg -> Affection StateData ()]
+generalSubscribers t = do
+  subTups <- liftIO $ readTVarIO t
+  return $ map snd subTups
+
+generalSubscribe
+  :: TVar [(UUID, msg -> Affection StateData ())]
+  -> (msg -> Affection StateData())
+  -> Affection StateData UUID
+generalSubscribe t funct = do
+  uuid <- genUUID
+  liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
+  return uuid
+
+generalUnSubscribe
+  :: TVar [(UUID, msg -> Affection StateData ())]
+  -> UUID
+  -> Affection StateData ()
+generalUnSubscribe t uuid =
+  liftIO $ atomically $ modifyTVar' t (filter (\(u, _) -> u /= uuid))
+
+instance Participant Main.Window StateData where
+  type Mesg Main.Window StateData = WindowMessage
+
+  partSubscribers (Window t) = generalSubscribers t
+
+  partSubscribe (Window t) = generalSubscribe t
+
+  partUnSubscribe (Window t) = generalUnSubscribe t
+
+instance SDLSubsystem Main.Window StateData where
+  consumeSDLEvents = consumeSDLWindowEvents
+
+instance Participant Mouse StateData where
+  type Mesg Mouse StateData = MouseMessage
+
+  partSubscribers (Mouse t) = generalSubscribers t
+
+  partSubscribe (Mouse t) = generalSubscribe t
+
+  partUnSubscribe (Mouse t) = generalUnSubscribe t
+
+instance SDLSubsystem Mouse StateData where
+  consumeSDLEvents = consumeSDLMouseEvents
+
+instance Participant Keyboard StateData where
+  type Mesg Keyboard StateData = KeyboardMessage
+
+  partSubscribers (Keyboard t) = generalSubscribers t
+
+  partSubscribe (Keyboard t) = generalSubscribe t
+
+  partUnSubscribe (Keyboard t) = generalUnSubscribe t
+
+instance SDLSubsystem Keyboard StateData where
+  consumeSDLEvents = consumeSDLKeyboardEvents
+
+instance Participant Joystick StateData where
+  type Mesg Joystick StateData = JoystickMessage
+
+  partSubscribers (Joystick t) = generalSubscribers t
+
+  partSubscribe (Joystick t) = generalSubscribe t
+
+  partUnSubscribe (Joystick t) = generalUnSubscribe t
+
+instance SDLSubsystem Joystick StateData where
+  consumeSDLEvents = consumeSDLJoystickEvents
+
+main :: IO ()
+main = do
+  logIO Debug "Starting"
+  let conf = AffectionConfig
+        { initComponents = All
+        , windowTitle = "affection: example00"
+        , windowConfig = SDL.defaultWindow
+          { SDL.windowOpenGL = Just SDL.defaultOpenGL
+            { SDL.glProfile = SDL.Core SDL.Normal 3 3
+            }
+          }
+        , initScreenMode = SDL.Windowed
+        , canvasSize = Nothing
+        , loadState = load
+        , preLoop = pre
+        , eventLoop = handle
+        , updateLoop = update
+        , drawLoop = draw
+        , cleanUp = clean
+        }
+  withAffection conf
+
+load :: IO StateData
+load =
+  StateData <$> (Subsystems
+    <$> (Window <$> newTVarIO [])
+    <*> (Mouse <$> newTVarIO [])
+    <*> (Keyboard <$> newTVarIO [])
+    <*> (Joystick <$> newTVarIO [])
+    )
+    <*> return []
+
+pre :: Affection StateData ()
+pre = do
+  sd <- getAffection
+  _ <- partSubscribe (subKeyboard $ sdSubs sd) exitOnQ
+  _ <- partSubscribe (subWindow $ sdSubs sd) exitOnWindowClose
+  _ <- partSubscribe (subJoystick $ sdSubs sd) joyConnectDisconnect
+  return ()
+
+exitOnQ :: KeyboardMessage -> Affection StateData ()
+exitOnQ (MsgKeyboardEvent _ _ _ _ sym) =
+  case SDL.keysymKeycode sym of
+    SDL.KeycodeQ -> do
+      liftIO $ logIO Debug "Yo dog I heard..."
+      quit
+    _ -> return ()
+
+exitOnWindowClose :: WindowMessage -> Affection StateData ()
+exitOnWindowClose wm =
+  case wm of
+    MsgWindowClose _ _ -> do
+      liftIO $ logIO Debug "I heard another one..."
+      quit
+    _ -> return ()
+
+joyConnectDisconnect :: JoystickMessage -> Affection StateData ()
+joyConnectDisconnect msg = do
+  mj <- joystickAutoConnect msg
+  when (isJust mj) $ do
+    sd <- getAffection
+    putAffection sd
+      { sdJoys = fromJust mj : sdJoys sd
+      }
+  sd <- getAffection
+  njs <- joystickAutoDisconnect (sdJoys sd) msg
+  putAffection sd
+    { sdJoys = njs
+    }
+
+handle :: [SDL.EventPayload] -> Affection StateData ()
+handle es = do
+  (Subsystems a b c d) <- sdSubs <$> getAffection
+  leftovers <- consumeSDLEvents a
+    =<< consumeSDLEvents b
+    =<< consumeSDLEvents c
+    =<< consumeSDLEvents d es
+  mapM_ (\e -> liftIO $ logIO Verbose $ "LEFTOVER: " ++ show e) leftovers
+
+update _ = return ()
+
+draw = return ()
+
+clean _ = return ()
diff --git a/examples/example01/Main.hs b/examples/example01/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/example01/Main.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Affection as A
+import SDL (($=))
+import qualified SDL
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Control.Concurrent.STM
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad (when)
+import Control.DeepSeq (deepseq)
+
+import Data.Matrix as M
+import qualified Data.Set as S
+
+import System.Random (randomRIO)
+
+import NanoVG hiding (V2(..))
+
+import Linear
+
+import Foreign.C.Types (CInt(..))
+
+-- internal imports
+
+import Types
+
+foreign import ccall unsafe "glewInit"
+  glewInit :: IO CInt
+
+main :: IO ()
+main = do
+  logIO A.Debug "Starting"
+  let conf = AffectionConfig
+        { initComponents = All
+        , windowTitle = "affection: example01"
+        , windowConfig = SDL.defaultWindow
+          { SDL.windowOpenGL = Just SDL.defaultOpenGL
+            { SDL.glProfile = SDL.Core SDL.Normal 3 3
+            }
+          , SDL.windowInitialSize = SDL.V2 600 600
+          , SDL.windowResizable = True
+          }
+        , initScreenMode = SDL.Windowed
+        , canvasSize = Nothing
+        , loadState = load
+        , preLoop = pre
+        , eventLoop = handle
+        , updateLoop = update
+        , drawLoop = draw
+        , cleanUp = clean
+        }
+  withAffection conf
+
+load :: IO UserData
+load = do
+  -- emptyMatrix <- zero 60 60
+  liftIO $ logIO A.Debug "init GLEW"
+  _ <- glewInit
+  liftIO $ logIO A.Debug "making random"
+  randList <- mapM (\_ -> randomRIO (0,1)) [0..3599]
+  liftIO $ logIO A.Debug "creating context"
+  nanoCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug])
+  let fullMatrix = fromList 60 60 randList
+  -- logIO A.Debug $ prettyMatrix fullMatrix
+  empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection UserData ())])
+  empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection UserData ())])
+  return $ UserData
+    { subsystems = Subsystems
+      (Window empty1)
+      (Keyboard empty3)
+    , lifeMat = fullMatrix
+    , foodMat = fromList 60 60 (repeat 10)
+    , timeMat = M.zero 60 60
+    , nano = nanoCtx
+    , lastUpdate = 0
+    }
+
+pre :: Affection UserData ()
+pre = do
+  sd <- getAffection
+  _ <- partSubscribe (subKeyboard $ subsystems sd) exitOnEsc
+  _ <- partSubscribe (subKeyboard $ subsystems sd) reloadOnR
+  _ <- partSubscribe (subKeyboard $ subsystems sd) showFPS
+  _ <- partSubscribe (subWindow   $ subsystems sd) exitOnWindowClose
+  _ <- partSubscribe (subWindow   $ subsystems sd) windowResize
+  now <- getElapsedTime
+  putAffection sd
+    { lastUpdate = floor now
+    }
+
+exitOnEsc :: KeyboardMessage -> Affection UserData ()
+exitOnEsc (MsgKeyboardEvent _ _ _ _ sym) =
+  case SDL.keysymKeycode sym of
+    SDL.KeycodeEscape -> do
+      liftIO $ logIO A.Debug "Yo dog I heard..."
+      quit
+    _ -> return ()
+
+reloadOnR :: KeyboardMessage -> Affection UserData ()
+reloadOnR (MsgKeyboardEvent _ _ _ _ sym) =
+  case SDL.keysymKeycode sym of
+    SDL.KeycodeR -> reload
+    _ -> return ()
+
+reload :: Affection UserData ()
+reload = do
+  ud <- getAffection
+  now <- getElapsedTime
+  randList <- liftIO $ mapM (\_ -> randomRIO (0,1)) [0..3599]
+  let fullMatrix = fromList 60 60 randList
+  putAffection ud
+    { lifeMat = fullMatrix
+    , foodMat = fromList 60 60 (repeat 10)
+    , timeMat = M.zero 60 60
+    , lastUpdate = floor now
+    }
+
+showFPS :: KeyboardMessage -> Affection UserData ()
+showFPS (MsgKeyboardEvent _ _ _ _ sym) =
+  case SDL.keysymKeycode sym of
+    SDL.KeycodeF -> do
+      dt <- getDelta
+      liftIO $ logIO A.Debug $ "FPS: " ++ show (1 / dt)
+    _ -> return ()
+
+exitOnWindowClose :: WindowMessage -> Affection UserData ()
+exitOnWindowClose wm =
+  case wm of
+    MsgWindowClose _ _ -> do
+      liftIO $ logIO A.Debug "I heard another one..."
+      quit
+    _ -> return ()
+
+windowResize :: WindowMessage -> Affection UserData ()
+windowResize msg = case msg of
+  (MsgWindowResize _ _ (V2 w h)) -> do
+    liftIO $ logIO A.Debug "Window resized"
+    let nw = floor (fromIntegral h)
+        dw = floor ((fromIntegral w - fromIntegral nw) / 2)
+    GL.viewport $= (GL.Position dw 0, GL.Size nw h)
+  _ -> return ()
+
+handle :: [SDL.EventPayload] -> Affection UserData ()
+handle es = do
+  (Subsystems a b) <- subsystems <$> getAffection
+  _ <- consumeSDLEvents a =<< consumeSDLEvents b es
+  return ()
+
+update :: Double -> Affection UserData ()
+update _ = do
+  ud <- getAffection
+  newList <- mapM (\coord -> do
+    let x = (coord `mod` 60) + 1
+        y = (coord `div` 60) + 1
+        subm
+          | x == 1 && y == 1 =
+            submatrix 60 60 60 60 (lifeMat ud) <|> submatrix 60 60 1 2 (lifeMat ud)
+            <->
+            submatrix 1 2 60 60 (lifeMat ud) <|> submatrix 1 2 1 2 (lifeMat ud)
+          | x == 1 && y == 60 =
+            submatrix 59 60 60 60 (lifeMat ud) <|> submatrix 59 60 1 2 (lifeMat ud)
+            <->
+            submatrix 1 1 60 60 (lifeMat ud) <|> submatrix 1 1 1 2 (lifeMat ud)
+          | x == 60 && y == 1 =
+            submatrix 60 60 59 60 (lifeMat ud) <|> submatrix 60 60 1 1 (lifeMat ud)
+            <->
+            submatrix 1 2 59 60 (lifeMat ud) <|> submatrix 1 2 1 1 (lifeMat ud)
+          | x == 60 && y == 60 =
+            submatrix 59 60 59 60 (lifeMat ud) <|> submatrix 59 60 1 1 (lifeMat ud)
+            <->
+            submatrix 1 1 59 60 (lifeMat ud) <|> submatrix 1 1 1 1 (lifeMat ud)
+          | x == 1 =
+            submatrix (y - 1) (y + 1) 60 60 (lifeMat ud)
+            <|>
+            submatrix (y - 1) (y + 1) 1 2 (lifeMat ud)
+          | y == 1 =
+            submatrix 60 60 (x - 1) (x + 1) (lifeMat ud)
+            <->
+            submatrix 1 2 (x - 1) (x + 1) (lifeMat ud)
+          | x == 60 =
+            submatrix (y - 1) (y + 1) 59 60 (lifeMat ud)
+            <|>
+            submatrix (y - 1) (y + 1) 1 1 (lifeMat ud)
+          | y == 60 =
+            submatrix 59 60 (x -1 ) (x + 1) (lifeMat ud)
+            <->
+            submatrix 1 1 (x - 1) (x + 1) (lifeMat ud)
+          | otherwise =
+            submatrix (y - 1) (y + 1) (x - 1) (x + 1) (lifeMat ud)
+        life = countLife subm
+    if lifeMat ud M.! (y, x) == 1
+    then if life == 2 || life == 3 && foodMat ud M.! (y, x) > 0
+      then return (1, (foodMat ud M.! (y, x)) - 1, 0)
+      else return (0, foodMat ud M.! (y, x), 1)
+    else if life == 3 && foodMat ud M.! (y, x) > 0
+      then return (1, (foodMat ud M.! (y, x)) - 1, 0)
+      else return
+        ( 0
+        , if timeMat ud M.! (y, x) > 10
+          then min 10 ((foodMat ud M.! (y, x)) + 1)
+          else foodMat ud M.! (y, x)
+        , timeMat ud M.! (y, x) + 1
+        )
+    ) [0..3599]
+  let newLifeMat = fromList 60 60 (map (\(x, _, _) -> x) newList)
+  let newFoodMat = fromList 60 60 (map (\(_, x, _) -> x) newList)
+  let newTimeMat = fromList 60 60 (map (\(_, _, x) -> x) newList)
+  if newLifeMat == M.zero 60 60
+  then
+    reload
+  else
+    putAffection ((newLifeMat, newFoodMat, newTimeMat) `deepseq` ud)
+      { lifeMat = newLifeMat
+      , foodMat = newFoodMat
+      , timeMat = newTimeMat
+      -- , lastUpdate = floor now
+      }
+
+countLife :: Matrix Word -> Word
+countLife mat = res - (mat M.! (2, 2))
+  where
+    res = foldr (flip (+)) 0 mat
+
+draw :: Affection UserData ()
+draw = do
+  ud <- getAffection
+  liftIO $ do
+    beginFrame (nano ud) 600 600 1
+    save (nano ud)
+    mapM_ (\coord -> do
+      let x = coord `mod` 60
+          y = coord `div` 60
+          ctx = nano ud
+          mult = lifeMat ud M.! (x + 1, y + 1)
+      -- logIO A.Debug $ show mult
+      beginPath ctx
+      rect ctx (fromIntegral $ x * 10) (fromIntegral $ y * 10) 10 10
+      if mult == 1
+      then
+        fillColor ctx (rgba 255 255 255 255)
+      else
+        fillColor ctx (rgba 0 (fromIntegral $ 25 * (foodMat ud M.! (x+1, y+1))) 0 255)
+      fill ctx
+      ) [0..3599]
+    restore (nano ud)
+    endFrame (nano ud)
+
+clean _ = return ()
diff --git a/examples/example01/Types.hs b/examples/example01/Types.hs
new file mode 100644
--- /dev/null
+++ b/examples/example01/Types.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Types where
+
+import Affection
+
+import Data.Matrix as M
+
+import NanoVG
+
+import Control.Concurrent.STM
+import Control.Monad.IO.Class (liftIO)
+
+data UserData = UserData
+  { lifeMat    :: Matrix Word
+  , foodMat    :: Matrix Word
+  , timeMat    :: Matrix Word
+  , subsystems :: Subsystems
+  , nano       :: Context
+  , lastUpdate :: Int
+  }
+
+data Subsystems = Subsystems
+  { subWindow   :: Types.Window
+  , subKeyboard :: Types.Keyboard
+  }
+
+newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())])
+
+newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
+
+instance Participant Types.Window UserData where
+  type Mesg Types.Window UserData = WindowMessage
+
+  partSubscribers (Window t) = do
+    subTups <- liftIO $ readTVarIO t
+    return $ map snd subTups
+
+  partSubscribe (Window t) = generalSubscribe t
+
+  partUnSubscribe (Window t) = generalUnSubscribe t
+
+instance SDLSubsystem Types.Window UserData where
+  consumeSDLEvents = consumeSDLWindowEvents
+
+instance Participant Keyboard UserData where
+  type Mesg Keyboard UserData = KeyboardMessage
+
+  partSubscribers (Keyboard t) = do
+    subTups <- liftIO $ readTVarIO t
+    return $ map snd subTups
+
+  partSubscribe (Keyboard t) = generalSubscribe t
+
+  partUnSubscribe (Keyboard t) = generalUnSubscribe t
+
+instance SDLSubsystem Keyboard UserData where
+  consumeSDLEvents = consumeSDLKeyboardEvents
+
+generalSubscribe
+  :: TVar [(UUID, msg -> Affection UserData ())]
+  -> (msg -> Affection UserData ())
+  -> Affection UserData UUID
+generalSubscribe t funct = do
+  uuid <- genUUID
+  liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
+  return uuid
+
+generalUnSubscribe
+  :: TVar [(UUID, msg -> Affection UserData ())]
+  -> UUID
+  -> Affection UserData ()
+generalUnSubscribe t uuid =
+  liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
+  where
+    filterMsg :: (UUID, msg -> Affection UserData ()) -> UUID -> Bool
+    filterMsg (u, _) p = u /= p
diff --git a/src/Affection.hs b/src/Affection.hs
--- a/src/Affection.hs
+++ b/src/Affection.hs
@@ -4,31 +4,32 @@
     ( withAffection
     , get
     , put
+    , liftIO
     , module A
     ) where
 
 import SDL (($=))
 import qualified SDL
+import qualified SDL.Raw.Video as SDL (glSetAttribute)
+import qualified SDL.Raw.Enum as SDL
 
 import System.Clock
 
 import Control.Monad.Loops
-import Control.Monad.State
+import Control.Monad.State.Strict
+import Control.Monad.IO.Class (liftIO)
 
 import Foreign.C.Types (CInt(..))
 
-import Debug.Trace
-
 import Affection.Types as A
 import Affection.StateMachine as A
-import Affection.MouseInteractable as A
 import Affection.Util as A
 import Affection.MessageBus as A
 import Affection.Subsystems as A
 
 import Affection.Logging as A
 
-import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
+import qualified Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
 
 
 -- | Main function which bootstraps everything else.
@@ -55,39 +56,14 @@
   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
       (w, h) = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (fromIntegral rw, fromIntegral rh)
   SDL.setWindowMode window initScreenMode
-  SDL.swapInterval $= SDL.SynchronizedUpdates
+  -- SDL.swapInterval $= SDL.SynchronizedUpdates -- <- causes Problems with windows
   liftIO $ logIO Debug "Getting Time"
   -- get current time
   execTime <- getTime Monotonic
@@ -109,10 +85,7 @@
   (_, nState) <- runStateT ( A.runState $ do
     liftIO $ logIO Debug "Starting Loop"
     preLoop
-    whileM_ (do
-        current <- get
-        return $ not $ A.quitEvent current
-      )
+    whileM_ (not . A.quitEvent <$> get)
       (do
         -- get state
         ad <- get
@@ -129,20 +102,16 @@
           }
         -- poll events
         evs <- preHandleEvents =<< liftIO SDL.pollEvents
-        -- mapM_ eventLoop evs
+        -- handle events
         eventLoop evs
         -- execute user defined update loop
         unless (pausedTime ad) (updateLoop dt)
         -- execute user defined draw loop
-        liftIO $ GL.clear [ColorBuffer, DepthBuffer, StencilBuffer]
+        liftIO $ GL.clear [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer]
         drawLoop
-        liftIO flush
-        -- handle all new draw requests
-        ad2 <- get
-        -- actual drawing
+        liftIO GL.flush
+        -- actual displaying of newly drawn frame
         SDL.glSwapWindow window
-        -- SDL.copy renderer texture Nothing Nothing
-        -- SDL.present renderer
         -- save new time
         ad3 <- get
         when (sysTime ad == sysTime ad3) (
@@ -155,6 +124,7 @@
   liftIO $ logIO Debug "Loop ended. Cleaning"
   cleanUp $ userState nState
   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"
diff --git a/src/Affection/Logging.hs b/src/Affection/Logging.hs
--- a/src/Affection/Logging.hs
+++ b/src/Affection/Logging.hs
@@ -1,15 +1,23 @@
 {-# LANGUAGE CPP #-}
+-- | This module defines the logging capability of Affection, whis is derived
+-- from "Debug.Trace".
 module Affection.Logging where
 
 import Debug.Trace
 
+-- | The log level definition
 data LogLevel
-  = Verbose
-  | Debug
-  | Warn
-  | Error
+  = Verbose -- ^ Log everything
+  | Debug   -- ^ Log Debug messages and above
+  | Warn    -- ^ Log only Warnings and errors
+  | 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 @@
 #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
diff --git a/src/Affection/MessageBus.hs b/src/Affection/MessageBus.hs
--- a/src/Affection/MessageBus.hs
+++ b/src/Affection/MessageBus.hs
@@ -5,6 +5,5 @@
 
 import Affection.MessageBus.Class as M
 import Affection.MessageBus.Message as M
-import Affection.MessageBus.Util as M
 
 import Affection.MessageBus.Message as Msg
diff --git a/src/Affection/MessageBus/Class.hs b/src/Affection/MessageBus/Class.hs
--- a/src/Affection/MessageBus/Class.hs
+++ b/src/Affection/MessageBus/Class.hs
@@ -3,11 +3,10 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ExistentialQuantification #-}
-module Affection.MessageBus.Class 
+module Affection.MessageBus.Class
   ( Participant(..)
   , genUUID
   , UUID
-  , MsgId(..)
   ) where
 
 import Affection.MessageBus.Message
@@ -20,30 +19,33 @@
 
 import Affection.Logging
 
-class (Message msg, Show msg) => Participant prt msg us where
+-- | 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
+  -- | Message datatype
+  type Mesg prt us :: *
 
   -- | Function to get the list of subscribers from the participant
   partSubscribers
     :: prt
     -- ^ the 'Participant''s subscriber storage
-    -> Affection us [msg -> Affection us ()]
+    -> Affection us [Mesg prt us -> Affection us ()]
     -- ^ List of Subscriber functions
 
   -- | Subscribe to the 'Participant''s events
   partSubscribe
     :: prt
     -- ^ The 'Participant''s subscriber storage
-    -> (msg -> Affection us ())
+    -> (Mesg prt us -> Affection us ())
     -- ^ What to do in case of a 'Message'
     -- (Subscriber function)
-    -> Affection us (MsgId msg)
+    -> Affection us UUID
     -- ^ 'UUID' of the registered subscriber Function
 
   -- | Unsubscribe a Subscriber function from Participant
   partUnSubscribe
     :: prt
     -- ^ The 'Participant''s subscriber storage to unsubscribe from
-    -> (MsgId msg)
+    -> UUID
     -- ^ The subscriber function's 'UUID'
     -> Affection us ()
 
@@ -51,7 +53,7 @@
   partEmit
     :: prt
     -- ^ The 'Participant''s subscriber storage
-    -> msg
+    -> Mesg prt us
     -- ^ The 'Message' to emit
     -> Affection us ()
   partEmit p m = do
@@ -62,5 +64,3 @@
 -- | Helper function to generate new 'UUID's
 genUUID :: Affection us UUID
 genUUID = liftIO nextRandom
-
-data MsgId msg = (Message msg, Show msg) => MsgId UUID msg
diff --git a/src/Affection/MessageBus/Message.hs b/src/Affection/MessageBus/Message.hs
--- a/src/Affection/MessageBus/Message.hs
+++ b/src/Affection/MessageBus/Message.hs
@@ -6,3 +6,4 @@
 import Affection.MessageBus.Message.WindowMessage as M
 import Affection.MessageBus.Message.KeyboardMessage as M
 import Affection.MessageBus.Message.MouseMessage as M
+import Affection.MessageBus.Message.JoystickMessage as M
diff --git a/src/Affection/MessageBus/Message/Class.hs b/src/Affection/MessageBus/Message/Class.hs
--- a/src/Affection/MessageBus/Message/Class.hs
+++ b/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
diff --git a/src/Affection/MessageBus/Message/JoystickMessage.hs b/src/Affection/MessageBus/Message/JoystickMessage.hs
new file mode 100644
--- /dev/null
+++ b/src/Affection/MessageBus/Message/JoystickMessage.hs
@@ -0,0 +1,67 @@
+module Affection.MessageBus.Message.JoystickMessage 
+  ( JoystickMessage(..)
+    -- | Vector export
+  , Linear.V2
+    -- | SDL exports
+  , SDL.JoyHatPosition
+  , SDL.JoyButtonState
+  , SDL.JoyDeviceConnection
+    -- | Number exports
+  , Word8
+  , Int16
+  , Int32
+  ) where
+
+import Affection.MessageBus.Message.Class
+
+import Data.Word (Word8)
+import Data.Int (Int32, Int16)
+
+import qualified SDL
+
+import Linear (V2(..))
+
+-- | Datatype for handling all possible joystick events handed over from sdl2
+data JoystickMessage
+  -- | Movement of a Joystick axis
+  = MsgJoystickAxis
+    { msgJAWhen :: Double -- ^ Time of event
+    , msgJAWhich :: Int32 -- ^ Joystick identifier
+    , msgJAAxis :: Word8  -- ^ Axis identifier
+    , msgJAValue :: Int16 -- ^ Axis value
+    }
+  -- | Movement of a joystick ball controller
+  | MsgJoystickBall
+    { msgJBWhen :: Double            -- ^ Time of event
+    , msgJBWhich :: Int32            -- ^ Joystick identifier
+    , msgJBBall :: Word8             -- ^ Ball identifier
+    , msgJBRelMotion :: V2 Int16     -- ^ Motion relative to previous position
+    }
+  -- | Movement of joystick hat controller
+  | MsgJoystickHat
+    { msgJHWhen :: Double                 -- ^ Time of event
+    , msgJHWhich :: Int32                 -- ^ Joystick identifier
+    , msgJHHat :: Word8                   -- ^ Hat identifier
+    , msgJHPosition :: SDL.JoyHatPosition -- ^ New hat position
+    }
+  -- | Joystick button event
+  | MsgJoystickButton
+    { msgJBWhen :: Double              -- ^ Time of event
+    , msgJBWhich :: Int32              -- ^ Joystick identifier
+    , msgJBButton :: Word8             -- ^ Button identifier
+    , msgJBState :: SDL.JoyButtonState -- ^ New Button state
+    }
+  -- | Joystick device event
+  | MsgJoystickDevice
+    { msgJDWhen :: Double                        -- ^ Time of event
+    , msgJDWhich :: Int32                        -- ^ Joystick identifier
+    , msgJDConnection :: SDL.JoyDeviceConnection -- ^ Connection status
+    }
+  deriving (Show)
+
+instance Message JoystickMessage where
+  msgTime (MsgJoystickAxis t _ _ _)   = t
+  msgTime (MsgJoystickBall t _ _ _)   = t
+  msgTime (MsgJoystickHat t _ _ _)    = t
+  msgTime (MsgJoystickButton t _ _ _) = t
+  msgTime (MsgJoystickDevice t _ _)   = t
diff --git a/src/Affection/MessageBus/Message/KeyboardMessage.hs b/src/Affection/MessageBus/Message/KeyboardMessage.hs
--- a/src/Affection/MessageBus/Message/KeyboardMessage.hs
+++ b/src/Affection/MessageBus/Message/KeyboardMessage.hs
@@ -1,18 +1,25 @@
-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
+  -- | Arbitrary Keyboard event
   = MsgKeyboardEvent
-    { msgKbdWhen :: Double
-    , msgKbdWindow :: Maybe SDL.Window
-    , msgKbdKeyMotion :: SDL.InputMotion
-    , msgKbdKeyRepeat :: Bool
-    , msgKbdKeysym :: SDL.Keysym
+    { msgKbdWhen :: Double               -- ^ Message time
+    , msgKbdWindow :: Maybe SDL.Window   -- ^ Affected Window
+    , msgKbdKeyMotion :: SDL.InputMotion -- ^ Input motion of button (pressed/released)
+    , msgKbdKeyRepeat :: Bool            -- ^ Is this a repeated event?
+    , msgKbdKeysym :: SDL.Keysym         -- ^ The button's 'SDL.Keysym'
     }
-  | MsgKeyboardEmptyEvent
   deriving (Show)
 
 instance Message KeyboardMessage where
diff --git a/src/Affection/MessageBus/Message/MouseMessage.hs b/src/Affection/MessageBus/Message/MouseMessage.hs
--- a/src/Affection/MessageBus/Message/MouseMessage.hs
+++ b/src/Affection/MessageBus/Message/MouseMessage.hs
@@ -1,42 +1,54 @@
-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
 
-import Data.Word (Word8(..))
-import Data.Int (Int32(..))
+import Data.Word (Word8)
+import Data.Int (Int32)
 
 import qualified SDL
 
 import Linear (V2(..))
 
+-- Datatype for handling mouse events handed down from SDL2
 data MouseMessage
+  -- | Mouse motion event
   = MsgMouseMotion
-    { msgMMWhen :: Double
-    , msgMMWindow :: Maybe SDL.Window
-    , msgMMWhich :: SDL.MouseDevice
-    , msgMMState :: [SDL.MouseButton]
-    , msgMMPos :: V2 Int32
-    , msgMMRelMotion :: V2 Int32
+    { msgMMWhen :: Double             -- ^ Message time
+    , msgMMWindow :: Maybe SDL.Window -- ^ Focused window (if any)
+    , msgMMWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
+    , msgMMState :: [SDL.MouseButton] -- ^ List of pressed mouse buttons
+    , msgMMPos :: V2 Int32            -- ^ Absolute mouse positiom
+    , msgMMRelMotion :: V2 Int32      -- ^ Mouse movement relative to previous position
     }
+  -- | Mouse button event
   | MsgMouseButton
-    { msgMBWhen :: Double
-    , msgMBWindow :: Maybe SDL.Window
-    , msgMBWhich :: SDL.MouseDevice
-    , msgMBButton :: SDL.MouseButton
-    , msgMBClicks :: Word8
-    , msgMBPos :: V2 Int32
+    { msgMBWhen :: Double             -- ^ Message time
+    , msgMBWindow :: Maybe SDL.Window -- ^ Focused window (if any)
+    , msgMBMotion :: SDL.InputMotion  -- ^ Button's input motion
+    , msgMBWhich :: SDL.MouseDevice   -- ^ Mouse device identifier
+    , msgMBButton :: SDL.MouseButton  -- ^ Affected mouse button
+    , msgMBClicks :: Word8            -- ^ Number of clicks
+    , msgMBPos :: V2 Int32            -- ^ Absolute mouse position
     }
+  -- | Mouse wheel event
   | MsgMouseWheel
-    { msgMWWhen :: Double
-    , msgMWWhindow :: Maybe SDL.Window
-    , msgMWWhich :: SDL.MouseDevice
-    , msgMWPos :: V2 Int32
-    , msgMWDIrection :: SDL.MouseScrollDirection
+    { msgMWWhen :: Double                        -- ^ Message time
+    , msgMWWhindow :: Maybe SDL.Window           -- ^ Focused window (if any)
+    , msgMWWhich :: SDL.MouseDevice              -- ^ Mouse device identifier
+    , msgMWPos :: V2 Int32                       -- ^ Absolute mouse position
+    , msgMWDIrection :: SDL.MouseScrollDirection -- ^ Scroll direction
     }
-  | MsgMouseEmptyEvent
   deriving (Show)
 
 instance Message MouseMessage where
   msgTime (MsgMouseMotion t _ _ _ _ _) = t
-  msgTime (MsgMouseButton t _ _ _ _ _) = t
+  msgTime (MsgMouseButton t _ _ _ _ _ _) = t
   msgTime (MsgMouseWheel t _ _ _ _) = t
diff --git a/src/Affection/MessageBus/Message/WindowMessage.hs b/src/Affection/MessageBus/Message/WindowMessage.hs
--- a/src/Affection/MessageBus/Message/WindowMessage.hs
+++ b/src/Affection/MessageBus/Message/WindowMessage.hs
@@ -1,84 +1,101 @@
-module Affection.MessageBus.Message.WindowMessage where
+module Affection.MessageBus.Message.WindowMessage
+  ( WindowMessage(..)
+  -- | SDL reexports
+  , SDL.Window
+  ) where
 
 import Affection.MessageBus.Message.Class
 
-import Data.Int (Int32(..))
+import Data.Int (Int32)
 
 import qualified SDL
 
 import Linear (V2(..))
 
+-- | Datatype for handling Window events handed down rom SDL2
 data WindowMessage
-  -- = MsgEngineReady Double
+  -- | Window show event
   = MsgWindowShow
-    { msgWSWhen :: Double
-    , msgWSWindow :: SDL.Window
+    { msgWSWhen :: Double       -- ^ Message time
+    , msgWSWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window hide event
   | MsgWindowHide
-    { msgWHWhen :: Double
-    , msgWHWindow :: SDL.Window
+    { msgWHWhen :: Double       -- ^ Message time
+    , msgWHWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window expose event
   | MsgWindowExpose
-    { msgWEWhen :: Double
-    , msgWEWindow :: SDL.Window
+    { msgWEWhen :: Double       -- ^ Message time
+    , msgWEWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window move event
   | MsgWindowMove
-    { msgWMWhen :: Double
-    , msgWMWindow :: SDL.Window
-    , msgWMNewPos :: V2 Int32
+    { msgWMWhen :: Double       -- ^ Message time
+    , msgWMWindow :: SDL.Window -- ^ Window identifier
+    , msgWMNewPos :: V2 Int32   -- ^ New absolute window position
     }
+  -- | Window resize event
   | MsgWindowResize
-    { msgWRWhen :: Double
-    , msgWRWindow :: SDL.Window
-    , msgWRNewSize :: V2 Int32
+    { msgWRWhen :: Double       -- ^ Message time
+    , msgWRWindow :: SDL.Window -- ^ Window identifier
+    , msgWRNewSize :: V2 Int32  -- ^ New absolute window size
     }
+  -- | Window size change event
   | MsgWindowSizeChange
-    { msgWSCWhen :: Double
-    , msgWSCWindow :: SDL.Window
+    { msgWSCWhen    :: Double     -- ^ Message time
+    , msgWSCWindow  :: SDL.Window -- ^ Window identifier
+    , msgWSCNewSize :: V2 Int32   -- ^ New absolute window size
     }
+  -- | Window minimize event
   | MsgWindowMinimize
-    { msgWMinWhen :: Double
-    , msgWMinWindow :: SDL.Window
+    { msgWMinWhen   :: Double     -- ^ Message time
+    , msgWMinWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window maximize event
   | MsgWindowMaximize
-    { msgWMaxWhen :: Double
-    , msgWMaxWindow :: SDL.Window
+    { msgWMaxWhen   :: Double     -- ^ Message time
+    , msgWMaxWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window restore event
   | MsgWindowRestore
-    { msgWRestWhen :: Double
-    , msgWRestWindow :: SDL.Window
+    { msgWRestWhen   :: Double     -- ^ Message time
+    , msgWRestWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window gain mouse focus event
   | MsgWindowGainMouseFocus
-    { msgWGMFWhen :: Double
-    , msgWGMFWindow :: SDL.Window
+    { msgWGMFWhen   :: Double     -- ^ Message Time
+    , msgWGMFWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window lose mouse focus event
   | MsgWindowLoseMouseFocus
-    { msgWLMFWhen :: Double
-    , msgWLMFWindow :: SDL.Window
+    { msgWLMFWhen   :: Double     -- ^ Message Time
+    , msgWLMFWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window gain keyboard focus event
   | MsgWindowGainKeyboardFocus
-    { msgWGKFWhen :: Double
-    , msgWGKFWindow :: SDL.Window
+    { msgWGKFWhen   :: Double     -- ^ Message time
+    , msgWGKFWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window lose keyboard focus event
   | MsgWindowLoseKeyboardFocus
-    { msgWLKFWhen :: Double
-    , msgWLKFWindow :: SDL.Window
+    { msgWLKFWhen   :: Double     -- ^ Message time
+    , msgWLKFWindow :: SDL.Window -- ^ Window identifier
     }
+  -- | Window close event
   | MsgWindowClose
-    { msgWCWhen :: Double
-    , msgWCWindow :: SDL.Window
+    { msgWCWhen   :: Double     -- ^ Message time
+    , msgWCWindow :: SDL.Window -- ^ Window identifier
     }
-  | MsgWindowEmptyEvent
   deriving (Show)
 
 instance Message WindowMessage where
-  -- msgTime (MsgEngineReady t)   = t
   msgTime (MsgWindowShow t _) = t
   msgTime (MsgWindowHide t _) = t
   msgTime (MsgWindowExpose t _) = t
   msgTime (MsgWindowMove t _ _) = t
   msgTime (MsgWindowResize t _ _) = t
-  msgTime (MsgWindowSizeChange t _) = t
+  msgTime (MsgWindowSizeChange t _ _) = t
   msgTime (MsgWindowMinimize t _) = t
   msgTime (MsgWindowMaximize t _) = t
   msgTime (MsgWindowRestore t _) = t
diff --git a/src/Affection/MessageBus/Util.hs b/src/Affection/MessageBus/Util.hs
deleted file mode 100644
--- a/src/Affection/MessageBus/Util.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Affection.MessageBus.Util where
-
--- zuru zuru
diff --git a/src/Affection/MouseInteractable.hs b/src/Affection/MouseInteractable.hs
deleted file mode 100644
--- a/src/Affection/MouseInteractable.hs
+++ /dev/null
@@ -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
diff --git a/src/Affection/StateMachine.hs b/src/Affection/StateMachine.hs
--- a/src/Affection/StateMachine.hs
+++ b/src/Affection/StateMachine.hs
@@ -6,9 +6,15 @@
 
 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 ()
diff --git a/src/Affection/Subsystems.hs b/src/Affection/Subsystems.hs
--- a/src/Affection/Subsystems.hs
+++ b/src/Affection/Subsystems.hs
@@ -6,3 +6,4 @@
 import Affection.Subsystems.AffectionKeyboard as S
 import Affection.Subsystems.AffectionWindow as S
 import Affection.Subsystems.AffectionMouse as S
+import Affection.Subsystems.AffectionJoystick as S
diff --git a/src/Affection/Subsystems/AffectionJoystick.hs b/src/Affection/Subsystems/AffectionJoystick.hs
new file mode 100644
--- /dev/null
+++ b/src/Affection/Subsystems/AffectionJoystick.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module Affection.Subsystems.AffectionJoystick where
+
+import Affection.MessageBus
+import Affection.Types
+import Affection.Util
+import Affection.Logging
+
+import Control.Monad (filterM)
+import Control.Monad.IO.Class (liftIO)
+
+import qualified Data.Vector as V
+
+import Foreign.C.Types (CInt(..))
+
+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)
+  => am                              -- ^ The message system participant
+  -> [SDL.EventPayload]              -- ^ Incoming events
+  -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events
+consumeSDLJoystickEvents am = doConsume
+  where
+    doConsume
+      :: [SDL.EventPayload]
+      -> Affection us [SDL.EventPayload]
+    doConsume [] = return []
+    doConsume (e:es) = do
+      ts <- getElapsedTime
+      case e of
+        SDL.JoyAxisEvent dat -> do
+          partEmit am (MsgJoystickAxis
+            ts
+            (SDL.joyAxisEventWhich dat)
+            (SDL.joyAxisEventAxis dat)
+            (SDL.joyAxisEventValue dat)
+            )
+          doConsume es
+        SDL.JoyBallEvent dat -> do
+          partEmit am (MsgJoystickBall
+            ts
+            (SDL.joyBallEventWhich dat)
+            (SDL.joyBallEventBall dat)
+            (SDL.joyBallEventRelMotion dat)
+            )
+          doConsume es
+        SDL.JoyHatEvent dat -> do
+          partEmit am (MsgJoystickHat
+            ts
+            (SDL.joyHatEventWhich dat)
+            (SDL.joyHatEventHat dat)
+            (SDL.joyHatEventValue dat)
+            )
+          doConsume es
+        SDL.JoyButtonEvent dat -> do
+          partEmit am (MsgJoystickButton
+            ts
+            (SDL.joyButtonEventWhich dat)
+            (SDL.joyButtonEventButton dat)
+            (SDL.joyButtonEventState dat)
+            )
+          doConsume es
+        SDL.JoyDeviceEvent dat -> do
+          partEmit am (MsgJoystickDevice
+            ts
+            (SDL.joyDeviceEventWhich dat)
+            (SDL.joyDeviceEventConnection dat)
+            )
+          doConsume es
+        _ -> fmap (e :) (doConsume es)
+
+-- | 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 <$>
+    (V.filter (\(SDL.JoystickDevice _ i) -> i == CInt which) <$>
+      SDL.availableJoysticks)
+  logIO Verbose $ "Connecting Joystick " ++ show which ++ " " ++ show descr
+  Just <$> SDL.openJoystick descr
+joystickAutoConnect _ = return Nothing
+
+-- | 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
+    logIO Verbose $ "These are the Joysticks connected: " ++ show joyIds
+    [d] <- filterM (\j -> fmap (== which) (SDL.getJoystickID j)) js
+    logIO Verbose $ "disconnected joysticks: " ++ show d
+    logIO Verbose $ "Disconnecting Joystick " ++ show which
+    SDL.closeJoystick d
+    njoys <- filterM (\j -> return $ d /= j) js
+    logIO Verbose $ "returning joysticks: " ++ show njoys
+    return njoys
+joystickAutoDisconnect js _ = return js
diff --git a/src/Affection/Subsystems/AffectionKeyboard.hs b/src/Affection/Subsystems/AffectionKeyboard.hs
--- a/src/Affection/Subsystems/AffectionKeyboard.hs
+++ b/src/Affection/Subsystems/AffectionKeyboard.hs
@@ -1,22 +1,22 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Affection.Subsystems.AffectionKeyboard where
 
 import Affection.Types
 import Affection.Util
 import Affection.MessageBus
-import Affection.Subsystems.Class
 
-import Control.Concurrent.STM as STM
-import Control.Monad.IO.Class (liftIO)
-
 import qualified SDL
 
+-- | Helper function that consumes all Keyboard-related 'SDL.EventPayload's
+-- and emits appropriate 'KeyboardMessage's
 consumeSDLKeyboardEvents
-  :: (Participant ak KeyboardMessage us)
-  => ak
-  -> [SDL.EventPayload]
-  -> Affection us [SDL.EventPayload]
+  :: forall ak us. (Participant ak us, Mesg ak us ~ KeyboardMessage)
+  => ak                              -- ^ The message system participant
+  -> [SDL.EventPayload]              -- ^ Incoming events
+  -> Affection us [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
--- a/src/Affection/Subsystems/AffectionMouse.hs
+++ b/src/Affection/Subsystems/AffectionMouse.hs
@@ -1,26 +1,29 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 module Affection.Subsystems.AffectionMouse where
 
 import Affection.MessageBus
-import Affection.Subsystems.Class
 import Affection.Types
 import Affection.Util
 
-import Control.Monad.IO.Class (liftIO)
-import Control.Concurrent.STM
-
 import Linear.Affine (unP)
 
 import qualified SDL
 
+-- | Helper funtion that consumes all Mouse-related 'SDL.Eventpayload's
+-- and emits appropriate 'MouseMessage's
 consumeSDLMouseEvents
-  :: (Participant am MouseMessage us)
-  => am
-  -> [SDL.EventPayload]
-  -> Affection us [SDL.EventPayload]
+  :: forall am us. (Participant am us, Mesg am us ~ MouseMessage)
+  => am                              -- ^ The message system participant
+  -> [SDL.EventPayload]              -- ^ Incoming events
+  -> Affection us [SDL.EventPayload] -- ^ Leftover SDL events
 consumeSDLMouseEvents am = doConsume
   where
+    doConsume
+      :: [SDL.EventPayload]
+      -> Affection us [SDL.EventPayload]
     doConsume [] = return []
     doConsume (e:es) = do
       ts <- getElapsedTime
@@ -39,6 +42,7 @@
           partEmit am (MsgMouseButton
             ts
             (SDL.mouseButtonEventWindow dat)
+            (SDL.mouseButtonEventMotion dat)
             (SDL.mouseButtonEventWhich dat)
             (SDL.mouseButtonEventButton dat)
             (SDL.mouseButtonEventClicks dat)
diff --git a/src/Affection/Subsystems/AffectionWindow.hs b/src/Affection/Subsystems/AffectionWindow.hs
--- a/src/Affection/Subsystems/AffectionWindow.hs
+++ b/src/Affection/Subsystems/AffectionWindow.hs
@@ -1,25 +1,30 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 module Affection.Subsystems.AffectionWindow where
 
 import Affection.Types
 import Affection.Util
 import Affection.MessageBus
-import Affection.Subsystems.Class
 
-import Control.Concurrent.STM as STM
-import Control.Monad.IO.Class (liftIO)
-
 import qualified SDL
 
+-- | Helper function that consumes all Window-related 'SDL.EventPayload's
+-- and emits appropriate 'WindowMessage's.
 consumeSDLWindowEvents
-  :: (Participant aw WindowMessage us)
-  => aw
-  -> [SDL.EventPayload]
-  -> Affection us [SDL.EventPayload]
+  :: forall aw us. (Participant aw us, Mesg aw us ~ WindowMessage)
+  => aw                               -- ^ The message system participant
+  -> [SDL.EventPayload]               -- ^ Incoming events
+  -> Affection us [SDL.EventPayload]  -- ^ Leftover SDL events
 consumeSDLWindowEvents aw = doConsume
   where
+    doConsume
+      :: (Mesg aw us ~ WindowMessage)
+      => [SDL.EventPayload]
+      -> Affection us [SDL.EventPayload]
     doConsume [] = return []
     doConsume (e:es) = do
       ts <- getElapsedTime
@@ -39,8 +44,8 @@
         SDL.WindowResizedEvent (SDL.WindowResizedEventData window newSize) -> do
           partEmit aw (MsgWindowResize ts window newSize)
           doConsume es
-        SDL.WindowSizeChangedEvent (SDL.WindowSizeChangedEventData window) -> do
-          partEmit aw (MsgWindowSizeChange ts window)
+        SDL.WindowSizeChangedEvent (SDL.WindowSizeChangedEventData window size) -> do
+          partEmit aw (MsgWindowSizeChange ts window size)
           doConsume es
         SDL.WindowMinimizedEvent (SDL.WindowMinimizedEventData window) -> do
           partEmit aw (MsgWindowMinimize ts window)
diff --git a/src/Affection/Subsystems/Class.hs b/src/Affection/Subsystems/Class.hs
--- a/src/Affection/Subsystems/Class.hs
+++ b/src/Affection/Subsystems/Class.hs
@@ -3,9 +3,11 @@
 module Affection.Subsystems.Class where
 
 import Affection.Types
-import Affection.MessageBus
 
 import qualified SDL
 
+-- | This class denotes a Subsystem to be part of 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]
diff --git a/src/Affection/Types.hs b/src/Affection/Types.hs
--- a/src/Affection/Types.hs
+++ b/src/Affection/Types.hs
@@ -1,57 +1,32 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-}
-module Affection.Types
-  -- ( Affection
-  -- , AffectionData(..)
-  -- , AffectionConfig(..)
-  -- , AffectionState(..)
-  -- -- , AffectionDraw(..)
-  -- -- , Draw(..)
-  -- , AffectionStateInner
-  -- -- , AffectionDrawInner(..)
-  -- , InitComponents(..)
-  -- -- , Loop(..)
-  -- -- , RGBA(..)
-  -- , DrawType(..)
-  -- , DrawRequest(..)
-  -- , RequestPersist(..)
-  -- , Angle(..)
-  -- -- , ConvertAngle(..)
-  --   -- | Particle system
-  -- , Particle(..)
-  -- , ParticleSystem(..)
-  -- , ParticleStorage(..)
-  --   -- | Convenience exports
-  -- , liftIO
-  -- , SDL.WindowConfig(..)
-  -- , SDL.defaultWindow
-  --   -- | GEGL reexports
-  -- , G.GeglRectangle(..)
-  -- , G.GeglBuffer(..)
-  -- )
-  where
+module Affection.Types 
+  ( Affection
+  , AffectionConfig(..)
+  , AffectionData(..)
+  , AffectionStateInner
+  , AffectionState(..)
+  , InitComponents(..)
+  , Angle
+  -- | SDL reexports
+  , SDL.WindowConfig(..)
+  , SDL.WindowMode(..)
+  , SDL.EventPayload(..)
+  , SDL.InitFlag(..)
+  , SDL.Window
+  , SDL.GLContext
+  ) where
 
 import qualified SDL.Init as SDL
 import qualified SDL.Video as SDL
 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
+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)
-
-import Affection.MessageBus.Message
-
 -- | Configuration for the aplication. needed at startup.
 data AffectionConfig us = AffectionConfig
   { initComponents :: InitComponents
@@ -85,42 +60,19 @@
 
 -- | 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
   , elapsedTime     :: Double             -- ^ Elapsed time in seconds
   , 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 +84,4 @@
 
 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
---   }
diff --git a/src/Affection/Util.hs b/src/Affection/Util.hs
--- a/src/Affection/Util.hs
+++ b/src/Affection/Util.hs
@@ -1,25 +1,25 @@
-module Affection.Util
-where
+module Affection.Util where
 
 import Affection.Types
 import Affection.Logging
+import Affection.MessageBus.Message.WindowMessage
 
+import SDL (($=))
 import qualified SDL
+import qualified Graphics.Rendering.OpenGL as GL
 
 import System.Clock
 
 import Control.Monad.State
 
--- Prehandle SDL events in case any window events occur
+-- | Prehandle SDL events
 preHandleEvents :: [SDL.Event] -> Affection us [SDL.EventPayload]
 preHandleEvents evs =
   return $ map SDL.eventPayload evs
 
 -- | Return the userstate to the user
 getAffection :: Affection us us
-getAffection = do
-  ad <- get
-  return $ userState ad
+getAffection = gets userState
 
 -- | Put altered user state back
 putAffection
@@ -38,13 +38,13 @@
 
 -- | Get time since start but always the same in the current tick.
 getElapsedTime :: Affection us Double
-getElapsedTime =
-  elapsedTime <$> get
+getElapsedTime = gets elapsedTime
 
+-- | Get delta time (time elapsed from last frame)
 getDelta :: Affection us Double
-getDelta =
-  deltaTime <$> get
+getDelta = gets deltaTime
 
+-- | Quit the engine loop
 quit :: Affection us ()
 quit = do
   ad <- get
@@ -63,10 +63,29 @@
       SDL.setWindowMode (drawWindow ad) SDL.Windowed
       return SDL.Windowed
     x -> do
-      liftIO $ logIO Warn ("Unknown Screen mode: " ++ show x)
+      liftIO $ logIO Warn ("Unexpected Screen mode: " ++ show x)
       return x
   now <- liftIO $ getTime Monotonic
   put ad
     { sysTime = now
     , screenMode = newMode
     }
+
+-- | Fit the GL Viewport to Window size
+fitViewport
+  :: Double               -- ^ Image Ratio (width / height)
+  -> WindowMessage        -- ^ Incoming Message. Listens only on
+                          -- 'MsgWindowResize' and ignores all others.
+  -> Affection us ()
+fitViewport ratio (MsgWindowResize _ _ (SDL.V2 w h)) = do
+  liftIO $ logIO Verbose "Fitting Viewport to size"
+  if (fromIntegral w / fromIntegral h) > ratio
+  then do
+    let nw = floor (fromIntegral h * ratio)
+        dw = floor ((fromIntegral w - fromIntegral nw) / 2 :: Double)
+    GL.viewport $= (GL.Position dw 0, GL.Size nw h)
+  else do
+    let nh = floor (fromIntegral w / ratio)
+        dh = floor ((fromIntegral h - fromIntegral nh) / 2 :: Double)
+    GL.viewport $= (GL.Position 0 dh, GL.Size w nh)
+fitViewport _ _ = return ()