diff --git a/aztecs-sdl.cabal b/aztecs-sdl.cabal
--- a/aztecs-sdl.cabal
+++ b/aztecs-sdl.cabal
@@ -1,6 +1,6 @@
 cabal-version: 2.4
 name:          aztecs-sdl
-version:       0.1.0.0
+version:       0.2.0.0
 license:       BSD-3-Clause
 license-file:  LICENSE
 maintainer:    matt@hunzinger.me
@@ -26,24 +26,50 @@
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
+        base >=4.6 && <5,
         aztecs >= 0.3,
         aztecs-asset >= 0.1,
         aztecs-transform >= 0.1,
-        containers >=0.7,
+        containers >=0.6,
         mtl >=2,
         sdl2 >=2,
-        sdl2-image >=2,
         text >=1.2,
         linear >= 1
 
+executable keyboard
+    main-is:          Keyboard.hs
+    hs-source-dirs:   examples
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    build-depends:
+        base >=4.6 && <5,
+        aztecs-sdl,
+        aztecs >= 0.3,
+        aztecs-asset >= 0.1,
+        aztecs-transform >= 0.1,
+        sdl2 >=2
+
+
+executable mouse
+    main-is:          Mouse.hs
+    hs-source-dirs:   examples
+    default-language: Haskell2010
+    ghc-options:      -Wall
+    build-depends:
+        base >=4.6 && <5,
+        aztecs-sdl,
+        aztecs >= 0.3,
+        aztecs-asset >= 0.1,
+        aztecs-transform >= 0.1,
+        sdl2 >=2
+
 executable window
     main-is:          Window.hs
     hs-source-dirs:   examples
     default-language: Haskell2010
     ghc-options:      -Wall
     build-depends:
-        base >=4 && <5,
+        base >=4.6 && <5,
         aztecs-sdl,
         aztecs >= 0.3,
         aztecs-asset >= 0.1,
diff --git a/examples/Keyboard.hs b/examples/Keyboard.hs
new file mode 100644
--- /dev/null
+++ b/examples/Keyboard.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Control.Arrow ((>>>))
+import Data.Aztecs
+import qualified Data.Aztecs.Access as A
+import qualified Data.Aztecs.Query as Q
+import Data.Aztecs.SDL (KeyboardInput, Window (..))
+import qualified Data.Aztecs.SDL as SDL
+import qualified Data.Aztecs.System as S
+
+setup :: System () ()
+setup = S.queue . const . A.spawn_ $ bundle Window {windowTitle = "Aztecs"}
+
+update :: System () ()
+update = S.all (Q.fetch @_ @KeyboardInput) >>> S.task print
+
+main :: IO ()
+main =
+  runSchedule_ $
+    schedule SDL.setup
+      >>> schedule setup
+      >>> forever (schedule SDL.update >>> schedule update >>> schedule SDL.draw)
diff --git a/examples/Mouse.hs b/examples/Mouse.hs
new file mode 100644
--- /dev/null
+++ b/examples/Mouse.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE Arrows #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Control.Arrow ((>>>))
+import Data.Aztecs
+import qualified Data.Aztecs.Access as A
+import qualified Data.Aztecs.Query as Q
+import Data.Aztecs.SDL (MouseInput, Window (..))
+import qualified Data.Aztecs.SDL as SDL
+import qualified Data.Aztecs.System as S
+
+setup :: System () ()
+setup = S.queue . const . A.spawn_ $ bundle Window {windowTitle = "Aztecs"}
+
+update :: System () ()
+update = S.all (Q.fetch @_ @MouseInput) >>> S.task print
+
+main :: IO ()
+main =
+  runSchedule_ $
+    schedule SDL.setup
+      >>> schedule setup
+      >>> forever (schedule SDL.update >>> schedule update >>> schedule SDL.draw)
diff --git a/examples/Window.hs b/examples/Window.hs
--- a/examples/Window.hs
+++ b/examples/Window.hs
@@ -4,39 +4,19 @@
 
 module Main where
 
-import Control.Arrow (returnA, (>>>))
+import Control.Arrow ((>>>))
 import Data.Aztecs
 import qualified Data.Aztecs.Access as A
-import Data.Aztecs.Asset (load)
-import qualified Data.Aztecs.Query as Q
-import Data.Aztecs.SDL (Image (..), Window (..))
+import Data.Aztecs.SDL (Window (..))
 import qualified Data.Aztecs.SDL as SDL
 import qualified Data.Aztecs.System as S
-import Data.Aztecs.Transform (Transform (..), transform)
-import SDL (V2 (..))
 
 setup :: System () ()
-setup =
-  S.mapSingle
-    ( proc () -> do
-        assetServer <- Q.fetch -< ()
-        (texture, assetServer') <- Q.run (load "example.png") -< assetServer
-        Q.set -< assetServer'
-        returnA -< texture
-    )
-    >>> S.queue
-      ( \texture -> do
-          A.spawn_ $ bundle Window {windowTitle = "Aztecs"}
-          A.spawn_ $
-            bundle Image {imageTexture = texture, imageSize = V2 100 100}
-              <> bundle transform {transformPosition = V2 100 100}
-          A.spawn_ $
-            bundle Image {imageTexture = texture, imageSize = V2 200 200}
-              <> bundle transform {transformPosition = V2 500 100}
-      )
-
-update :: System () ()
-update = S.all (Q.fetch @_ @SDL.Keyboard) >>> S.run (\keyboard -> print keyboard)
+setup = S.queue . const . A.spawn_ $ bundle Window {windowTitle = "Aztecs"}
 
 main :: IO ()
-main = runSystem_ $ SDL.setup >>> setup >>> S.forever (SDL.update >>> update >>> SDL.draw)
+main =
+  runSchedule_ $
+    schedule SDL.setup
+      >>> schedule setup
+      >>> forever (schedule SDL.update >>> schedule SDL.draw)
diff --git a/src/Data/Aztecs/SDL.hs b/src/Data/Aztecs/SDL.hs
--- a/src/Data/Aztecs/SDL.hs
+++ b/src/Data/Aztecs/SDL.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE Arrows #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -7,28 +8,77 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Data.Aztecs.SDL where
+module Data.Aztecs.SDL
+  ( -- * Window components
+    Window (..),
+    WindowRenderer (..),
 
+    -- * Camera components
+    Camera (..),
+    CameraTarget (..),
+
+    -- * Surface components
+    Surface (..),
+    SurfaceTarget (..),
+    SurfaceTexture (..),
+
+    -- * Input
+
+    -- ** Keyboard input
+    KeyboardInput (..),
+    isKeyPressed,
+    wasKeyPressed,
+    wasKeyReleased,
+
+    -- ** Mouse input
+    MouseInput (..),
+
+    -- * Time
+    Time (..),
+
+    -- * Systems
+    setup,
+    update,
+    draw,
+
+    -- ** Primitive systems
+    addWindows,
+    buildTextures,
+    drawTextures,
+    addCameraTargets,
+    addSurfaceTargets,
+    handleInput,
+    updateTime,
+    clearKeyboard,
+    clearKeyboardQuery,
+    clearMouseInput,
+    clearMouseInputQuery,
+  )
+where
+
 import Control.Arrow (Arrow (..), returnA, (>>>))
 import Data.Aztecs
 import qualified Data.Aztecs.Access as A
-import Data.Aztecs.Asset (Asset (..), AssetServer, Handle, lookupAsset)
-import qualified Data.Aztecs.Asset as Asset
 import qualified Data.Aztecs.Query as Q
 import qualified Data.Aztecs.System as S
-import Data.Aztecs.Transform (Transform (..))
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Maybe (mapMaybe)
+import Data.Aztecs.Transform (Size (..), Transform (..))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified Data.Text as T
-import Foreign.C (CInt)
-import SDL hiding (Texture, Window, windowTitle)
-import qualified SDL hiding (Texture)
-import qualified SDL.Image as IMG
+import Data.Word (Word32)
+import SDL hiding (Surface, Texture, Window, windowTitle)
+import qualified SDL
 
+#if !MIN_VERSION_base(4,20,0)
+import Data.Foldable (foldl')
+#endif
+
 -- | Window component.
 data Window = Window
-  { windowTitle :: String
+  { windowTitle :: !String
   }
   deriving (Show)
 
@@ -36,37 +86,56 @@
 
 -- | Window renderer component.
 data WindowRenderer = WindowRenderer
-  { windowRendererRaw :: SDL.Window,
-    windowRenderer :: Renderer
+  { windowRendererRaw :: !SDL.Window,
+    windowRenderer :: !Renderer
   }
   deriving (Show)
 
 instance Component WindowRenderer
 
+data Camera = Camera {cameraViewport :: !(V2 Int), cameraScale :: !(V2 Float)}
+  deriving (Show)
+
+instance Component Camera
+
+newtype CameraTarget = CameraTarget {cameraTargetWindow :: EntityID}
+  deriving (Eq, Show)
+
+instance Component CameraTarget
+
 -- | Setup SDL
 setup :: System () ()
 setup =
   fmap (const ()) $
-    Asset.setup @Texture
-      &&& S.run (const initializeAll)
-      &&& S.queue (const . A.spawn_ . bundle $ Keyboard mempty)
+    S.task (const initializeAll)
+      &&& S.queue
+        ( const $ do
+            A.spawn_ . bundle $ Time 0
+            A.spawn_ . bundle $ KeyboardInput mempty mempty
+            A.spawn_ . bundle $ MouseInput (P $ V2 0 0) (V2 0 0) mempty
+        )
 
 -- | Update SDL windows
 update :: System () ()
 update =
-  addWindows
-    >>> addWindowTargets
-    >>> Asset.loadAssets @Texture
-    >>> keyboardInput
+  const ()
+    <$> ( updateTime
+            &&& ( addWindows
+                    >>> addCameraTargets
+                    >>> addSurfaceTargets
+                    >>> handleInput
+                    >>> buildTextures
+                )
+        )
 
 draw :: System () ()
-draw = drawImages >>> renderWindows
+draw = const () <$> (drawTextures &&& clearKeyboard &&& clearMouseInput)
 
 -- | Setup new windows.
 addWindows :: System () ()
 addWindows = proc () -> do
   newWindows <- S.filter (Q.entity &&& Q.fetch @_ @Window) (without @WindowRenderer) -< ()
-  newWindows' <- S.run createNewWindows -< newWindows
+  newWindows' <- S.task createNewWindows -< newWindows
   S.queue insertNewWindows -< newWindows'
   where
     createNewWindows newWindows = mapM createWindowRenderer newWindows
@@ -77,164 +146,333 @@
     insertNewWindows newWindows' = mapM_ insertWindowRenderer newWindows'
     insertWindowRenderer (eId, window, renderer) = A.insert eId (WindowRenderer window renderer)
 
--- | Render windows.
-renderWindows :: System () ()
-renderWindows =
+newtype SurfaceTexture = SurfaceTexture {unSurfaceTexture :: SDL.Texture}
+
+instance Component SurfaceTexture
+
+buildTextures :: System () ()
+buildTextures =
   let go windowDraws =
         mapM_
-          ( \(window, draws) -> do
-              let renderer = windowRenderer window
-              rendererDrawColor renderer $= V4 0 0 0 255
-              clear renderer
-              mapM_ (\(d, transform) -> runDraw d transform renderer) draws
-              present renderer
+          ( \(window, cameraDraws) -> do
+              mapM_
+                ( \(_, cameraDraws') -> do
+                    let renderer = windowRenderer window
+                    mapM_
+                      ( \(eId, surface, transform, maybeTexture) -> do
+                          sdlTexture <- SDL.createTextureFromSurface renderer $ sdlSurface surface
+                          textureDesc <- queryTexture sdlTexture
+                          case maybeTexture of
+                            Just (SurfaceTexture lastTexture) -> destroyTexture lastTexture
+                            Nothing -> return ()
+                          A.insert eId (SurfaceTexture sdlTexture)
+                          A.insert
+                            eId
+                            ( Size $
+                                transformScale transform
+                                  * fromMaybe
+                                    (fmap fromIntegral $ V2 (textureWidth textureDesc) (textureHeight textureDesc))
+                                    ((fmap (\(Rectangle _ s) -> fmap fromIntegral s) $ surfaceBounds surface))
+                            )
+                      )
+                      cameraDraws'
+                )
+                cameraDraws
           )
           windowDraws
    in proc () -> do
+        cameras <- S.all $ Q.entity &&& Q.fetch -< ()
         windows <- S.all (Q.entity &&& Q.fetch @_ @WindowRenderer) -< ()
         draws <-
           S.all
             ( proc () -> do
-                d <- Q.fetch @_ @Draw -< ()
+                eId <- Q.entity -< ()
+                d <- Q.fetch @_ @Surface -< ()
                 transform <- Q.fetch @_ @Transform -< ()
-                target <- Q.fetch @_ @WindowTarget -< ()
-                returnA -< (d, transform, target)
+                target <- Q.fetch @_ @SurfaceTarget -< ()
+                maybeTexture <- Q.fetchMaybe @_ @SurfaceTexture -< ()
+                returnA -< (eId, d, transform, target, maybeTexture)
             )
             -<
               ()
-        let windowDraws =
-              foldr
-                ( \(eId, window) acc ->
-                    let draws' =
-                          foldr
-                            ( \(d, transform, target) acc' ->
-                                if unWindowTarget target == eId
-                                  then (d, transform) : acc'
-                                  else acc'
+        let cameraDraws =
+              map
+                ( \(eId, cameraTarget) ->
+                    ( cameraTarget,
+                      mapMaybe
+                        ( \(surfaceEid, d, transform, target, maybeTexture) ->
+                            if drawTargetCamera target == eId
+                              then Just (surfaceEid, d, transform, maybeTexture)
+                              else Nothing
+                        )
+                        draws
+                    )
+                )
+                cameras
+            windowDraws =
+              map
+                ( \(eId, window) ->
+                    ( window,
+                      filter (\(cameraTarget, _) -> cameraTargetWindow cameraTarget == eId) cameraDraws
+                    )
+                )
+                windows
+        S.queue go -< windowDraws
+
+drawTextures :: System () ()
+drawTextures =
+  let go windowDraws =
+        mapM_
+          ( \(window, cameraDraws) -> do
+              mapM_
+                ( \(camera, _, cameraTransform, cameraDraws') -> do
+                    let renderer = windowRenderer window
+                    rendererDrawColor renderer $= V4 0 0 0 255
+                    rendererScale renderer $= fmap realToFrac (cameraScale camera)
+                    rendererViewport renderer
+                      $= Just
+                        ( Rectangle
+                            (P (fmap fromIntegral $ transformPosition cameraTransform))
+                            (fmap fromIntegral $ cameraViewport camera)
+                        )
+                    clear renderer
+                    mapM_
+                      ( \(surface, transform, texture) -> do
+                          textureDesc <- queryTexture $ unSurfaceTexture texture
+                          copyEx
+                            renderer
+                            (unSurfaceTexture texture)
+                            (fmap fromIntegral <$> surfaceBounds surface)
+                            ( Just
+                                ( Rectangle
+                                    (fmap fromIntegral . P $ transformPosition transform)
+                                    ( fromMaybe
+                                        (fmap fromIntegral $ V2 (textureWidth textureDesc) (textureHeight textureDesc))
+                                        ((fmap (\(Rectangle _ s) -> fmap fromIntegral s) $ surfaceBounds surface))
+                                    )
+                                )
                             )
-                            []
-                            draws
-                     in (window, draws') : acc
+                            (realToFrac $ transformRotation transform)
+                            Nothing
+                            (V2 False False)
+                      )
+                      cameraDraws'
+                    present renderer
                 )
-                []
+                cameraDraws
+          )
+          windowDraws
+   in proc () -> do
+        cameras <-
+          S.all
+            ( proc () -> do
+                eId <- Q.entity -< ()
+                camera <- Q.fetch @_ @Camera -< ()
+                cameraTarget <- Q.fetch @_ @CameraTarget -< ()
+                t <- Q.fetch @_ @Transform -< ()
+                returnA -< (eId, camera, cameraTarget, t)
+            )
+            -<
+              ()
+        windows <- S.all (Q.entity &&& Q.fetch @_ @WindowRenderer) -< ()
+        draws <-
+          S.all
+            ( proc () -> do
+                d <- Q.fetch @_ @Surface -< ()
+                transform <- Q.fetch @_ @Transform -< ()
+                target <- Q.fetch @_ @SurfaceTarget -< ()
+                texture <- Q.fetch @_ @SurfaceTexture -< ()
+                returnA -< (d, transform, target, texture)
+            )
+            -<
+              ()
+        let cameraDraws =
+              map
+                ( \(eId, camera, cameraTarget, t) ->
+                    ( camera,
+                      cameraTarget,
+                      t,
+                      mapMaybe
+                        ( \(d, transform, target, texture) ->
+                            if drawTargetCamera target == eId
+                              then Just (d, transform, texture)
+                              else Nothing
+                        )
+                        draws
+                    )
+                )
+                cameras
+            windowDraws =
+              map
+                ( \(eId, window) ->
+                    ( window,
+                      filter (\(_, cameraTarget, _, _) -> cameraTargetWindow cameraTarget == eId) cameraDraws
+                    )
+                )
                 windows
-        S.run go -< windowDraws
+        S.task go -< windowDraws
 
--- | Window target component.
--- This component can be used to specify which `Window` to draw an entity to.
-newtype WindowTarget = WindowTarget {unWindowTarget :: EntityID}
+-- | Surface target component.
+-- This component can be used to specify which `Camera` to draw a `Surface` to.
+newtype SurfaceTarget = SurfaceTarget {drawTargetCamera :: EntityID}
   deriving (Eq, Show)
 
-instance Component WindowTarget
+instance Component SurfaceTarget
 
--- | Draw component.
+-- | Surface component.
 -- This component can be used to draw to a window.
-newtype Draw = Draw {runDraw :: Transform -> Renderer -> IO ()}
+data Surface = Surface
+  { sdlSurface :: !SDL.Surface,
+    surfaceBounds :: !(Maybe (Rectangle Int))
+  }
 
-instance Component Draw
+instance Component Surface
 
--- | Add `WindowTarget` components to entities with a new `Draw` component.
-addWindowTargets :: System () ()
-addWindowTargets = proc () -> do
-  windows <- S.all (Q.entity &&& Q.fetch @_ @WindowRenderer) -< ()
-  newDraws <- S.filter (Q.entity &&& Q.fetch @_ @Draw) (without @WindowTarget) -< ()
+-- | Add `CameraTarget` components to entities with a new `Draw` component.
+addCameraTargets :: System () ()
+addCameraTargets = proc () -> do
+  windows <- S.all (Q.entity &&& Q.fetch @_ @Window) -< ()
+  newCameras <- S.filter (Q.entity &&& Q.fetch @_ @Camera) (without @CameraTarget) -< ()
   S.queue
-    ( \(newDraws, windows) -> case windows of
-        (windowEId, _) : _ -> mapM_ (\(eId, _) -> A.insert eId $ WindowTarget windowEId) newDraws
+    ( \(newCameras, windows) -> case windows of
+        (windowEId, _) : _ -> mapM_ (\(eId, _) -> A.insert eId $ CameraTarget windowEId) newCameras
         _ -> return ()
     )
     -<
-      (newDraws, windows)
+      (newCameras, windows)
 
--- | Draw a rectangle.
-rect :: V2 Int -> Draw
-rect size = Draw $
-  \transform renderer -> do
-    surface <- createRGBSurface (fmap fromIntegral size) RGBA8888
-    surfaceRenderer <- createSoftwareRenderer surface
-    rendererDrawColor surfaceRenderer $= V4 255 0 0 255
-    fillRect surfaceRenderer Nothing
-    texture <- SDL.createTextureFromSurface renderer surface
-    copyEx
-      renderer
-      texture
-      Nothing
-      (Just (Rectangle (fmap (fromIntegral @CInt . round) . P $ transformPosition transform) (fmap fromIntegral size)))
-      (realToFrac $ transformRotation transform)
-      Nothing
-      (V2 False False)
-    freeSurface surface
-    destroyTexture texture
+-- | Add `SurfaceTarget` components to entities with a new `Surface` component.
+addSurfaceTargets :: System () ()
+addSurfaceTargets = proc () -> do
+  cameras <- S.all (Q.entity &&& Q.fetch @_ @Camera) -< ()
+  newDraws <- S.filter (Q.entity &&& Q.fetch @_ @Surface) (without @SurfaceTarget) -< ()
+  S.queue
+    ( \(newDraws, cameras) -> case cameras of
+        (cameraEId, _) : _ -> mapM_ (\(eId, _) -> A.insert eId $ SurfaceTarget cameraEId) newDraws
+        _ -> return ()
+    )
+    -<
+      (newDraws, cameras)
 
--- | Texture asset.
-newtype Texture = Texture {textureSurface :: Surface}
+newtype Time = Time {elapsedMS :: Word32}
+  deriving (Eq, Ord, Num, Show)
 
-instance Asset Texture where
-  loadAsset path = Texture <$> IMG.load path
+instance Component Time
 
--- | Image component.
-data Image = Image
-  { imageTexture :: Handle Texture,
-    imageSize :: V2 Int
+updateTime :: System () ()
+updateTime = proc () -> do
+  t <- S.task (const SDL.ticks) -< ()
+  S.mapSingle Q.set -< Time t
+  returnA -< ()
+
+-- | Keyboard input component.
+data KeyboardInput = KeyboardInput
+  { -- | Keyboard events that occured this frame.
+    keyboardEvents :: !(Map Keycode InputMotion),
+    -- | Keys that are currently pressed.
+    keyboardPressed :: !(Set Keycode)
   }
   deriving (Show)
 
-instance Component Image
+instance Component KeyboardInput
 
--- | Draw images to their target windows.
-drawImages :: System () ()
-drawImages = proc () -> do
-  imgs <- S.filter (Q.entity &&& Q.fetch @_ @Image) (without @Draw) -< ()
-  assets <- S.single (Q.fetch @_ @(AssetServer Texture)) -< ()
-  let newAssets =
-        mapMaybe (\(eId, img) -> (,img,eId) <$> lookupAsset (imageTexture img) assets) imgs
-  S.queue (mapM_ go) -< newAssets
-  where
-    go (texture, img, eId) = do
-      A.insert
-        eId
-        ( Draw $
-            \transform renderer -> do
-              sdlTexture <- SDL.createTextureFromSurface renderer (textureSurface texture)
-              copyEx
-                renderer
-                sdlTexture
-                Nothing
-                ( Just
-                    ( Rectangle
-                        (fmap (fromIntegral @CInt . round) . P $ transformPosition transform)
-                        (fmap fromIntegral $ imageSize img)
-                    )
-                )
-                (realToFrac $ transformRotation transform)
-                Nothing
-                (V2 False False)
-              destroyTexture sdlTexture
-        )
+-- | @True@ if this key is currently pressed.
+isKeyPressed :: Keycode -> KeyboardInput -> Bool
+isKeyPressed key kb = Set.member key $ keyboardPressed kb
 
--- | Keyboard state.
-newtype Keyboard = Keyboard {unKeyboard :: Map Keycode InputMotion}
-  deriving (Show, Semigroup, Monoid)
+-- | Check for a key event that occured this frame.
+keyEvent :: Keycode -> KeyboardInput -> Maybe InputMotion
+keyEvent key kb = Map.lookup key $ keyboardEvents kb
 
-instance Component Keyboard
+-- | @True@ if this key was pressed this frame.
+wasKeyPressed :: Keycode -> KeyboardInput -> Bool
+wasKeyPressed key kb = case keyEvent key kb of
+  Just Pressed -> True
+  _ -> False
 
+-- | @True@ if this key was released this frame.
+wasKeyReleased :: Keycode -> KeyboardInput -> Bool
+wasKeyReleased key kb = case keyEvent key kb of
+  Just Released -> True
+  _ -> False
+
+-- | Mouse input component.
+data MouseInput = MouseInput
+  { -- | Mouse position in screen-space.
+    mousePosition :: !(Point V2 Int),
+    -- | Mouse offset since last frame.
+    mouseOffset :: !(V2 Int),
+    -- | Mouse button states.
+    mouseButtons :: !(Map MouseButton InputMotion)
+  }
+  deriving (Show)
+
+instance Component MouseInput
+
 -- | Keyboard input system.
-keyboardInput :: System () ()
-keyboardInput = proc () -> do
-  events <- S.run . const $ SDL.pollEvents -< ()
-  S.mapSingle
-    ( proc events -> do
-        let go event keyAcc = case eventPayload event of
-              KeyboardEvent keyboardEvent ->
-                Keyboard $
+handleInput :: System () ()
+handleInput = proc () -> do
+  events <- S.task . const $ SDL.pollEvents -< ()
+  kb <- S.single Q.fetch -< ()
+  mouseInput <- S.single Q.fetch -< ()
+  let go (kbAcc, mouseAcc) event = case eventPayload event of
+        KeyboardEvent keyboardEvent ->
+          ( KeyboardInput
+              ( Map.insert
+                  (keysymKeycode $ keyboardEventKeysym keyboardEvent)
+                  (keyboardEventKeyMotion keyboardEvent)
+                  (keyboardEvents kbAcc)
+              )
+              ( case keyboardEventKeyMotion keyboardEvent of
+                  Pressed ->
+                    Set.insert
+                      (keysymKeycode $ keyboardEventKeysym keyboardEvent)
+                      (keyboardPressed kbAcc)
+                  Released ->
+                    Set.delete
+                      (keysymKeycode $ keyboardEventKeysym keyboardEvent)
+                      (keyboardPressed kbAcc)
+              ),
+            mouseAcc
+          )
+        MouseMotionEvent mouseMotionEvent ->
+          ( kbAcc,
+            MouseInput
+              { mousePosition = (fmap fromIntegral $ mouseMotionEventPos mouseMotionEvent),
+                mouseOffset = (fmap fromIntegral $ mouseMotionEventRelMotion mouseMotionEvent),
+                mouseButtons = (mouseButtons mouseAcc)
+              }
+          )
+        MouseButtonEvent mouseButtonEvent ->
+          ( kbAcc,
+            MouseInput
+              { mousePosition = (fmap fromIntegral $ mouseButtonEventPos mouseButtonEvent),
+                mouseOffset = V2 0 0,
+                mouseButtons =
                   Map.insert
-                    (keysymKeycode $ keyboardEventKeysym keyboardEvent)
-                    (keyboardEventKeyMotion keyboardEvent)
-                    (unKeyboard keyAcc)
-              _ -> keyAcc
-        keyboard <- Q.fetch -< ()
-        Q.set -< foldr go keyboard events
-    )
-    -<
-      events
+                    (mouseButtonEventButton mouseButtonEvent)
+                    (mouseButtonEventMotion mouseButtonEvent)
+                    (mouseButtons mouseAcc)
+              }
+          )
+        _ -> (kbAcc, mouseAcc)
+      (kb', mouseInput') = foldl' go (kb, mouseInput) events
+  S.mapSingle Q.set -< kb'
+  S.mapSingle Q.set -< mouseInput'
   returnA -< ()
+
+clearKeyboardQuery :: (Monad m) => Query m () KeyboardInput
+clearKeyboardQuery = proc () -> do
+  kb <- Q.fetch -< ()
+  Q.set -< kb {keyboardEvents = mempty}
+
+clearKeyboard :: System () ()
+clearKeyboard = const () <$> S.mapSingle clearKeyboardQuery
+
+clearMouseInputQuery :: (Monad m) => Query m () MouseInput
+clearMouseInputQuery = proc () -> do
+  mouseInput <- Q.fetch -< ()
+  Q.set -< mouseInput {mouseButtons = mempty, mouseOffset = V2 0 0}
+
+clearMouseInput :: System () ()
+clearMouseInput = const () <$> S.mapSingle clearMouseInputQuery