diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,25 @@
+# Animate Preview
+
+## OSX build
+
+```
+brew install sdl2
+brew install sdl2_ttf
+brew install sdl2_image
+brew install sdl2_gfx
+stack build
+```
+
+## Ubuntu build
+
+```
+sudo apt install libsdl2-dev libsdl2-ttf-dev libsdl2-image-dev libsdl2-gfx-dev
+stack build
+```
+
+## Windows build
+
+```
+stack exec -- pacman -S mingw64/mingw-w64-x86_64-pkg-config mingw64/mingw-w64-x86_64-SDL2 mingw64/mingw-w64-x86_64-SDL2_ttf mingw64/mingw-w64-x86_64-SDL2_image mingw64/mingw-w64-x86_64-SDL2_gfx
+stack build
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/animate-preview.cabal b/animate-preview.cabal
new file mode 100644
--- /dev/null
+++ b/animate-preview.cabal
@@ -0,0 +1,98 @@
+-- This file has been generated from package.yaml by hpack version 0.20.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 51d99c14d61a1d85be7c9e79e08619cb9077082c77d374d45595f5a1cc88b81e
+
+name:           animate-preview
+version:        0.0.0
+synopsis:       Preview tool for sprite animation
+description:    Preview tool for sprite animation
+category:       Game
+homepage:       https://github.com/jxv/animate-preview#readme
+bug-reports:    https://github.com/jxv/animate-preview/issues
+maintainer:     Joe Vargas
+copyright:      2018 Joe Vargas
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+
+extra-source-files:
+    package.yaml
+    README.md
+    stack.yaml
+
+data-files:
+    resource/ProggyClean.ttf
+
+source-repository head
+  type: git
+  location: https://github.com/jxv/animate-preview
+
+library
+  hs-source-dirs:
+      library
+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables OverloadedStrings DefaultSignatures MultiParamTypeClasses
+  ghc-options: -Wall
+  build-depends:
+      StateVar
+    , aeson
+    , animate
+    , base >=4.7 && <5
+    , bytestring
+    , containers
+    , filepath
+    , fsnotify
+    , key-state
+    , lens
+    , linear
+    , mtl
+    , optparse-applicative
+    , optparse-generic
+    , random
+    , safe
+    , safe-exceptions
+    , sdl2
+    , sdl2-gfx
+    , sdl2-image
+    , sdl2-ttf
+    , text
+    , text-conversions
+    , vector
+  exposed-modules:
+      Animate.Preview
+      Animate.Preview.Animation
+      Animate.Preview.Color
+      Animate.Preview.Config
+      Animate.Preview.Frame
+      Animate.Preview.Input
+      Animate.Preview.Loader
+      Animate.Preview.Logger
+      Animate.Preview.ManagerInput
+      Animate.Preview.Mode
+      Animate.Preview.Renderer
+      Animate.Preview.Resource
+      Animate.Preview.Runner
+      Animate.Preview.Scalar
+      Animate.Preview.Scene
+      Animate.Preview.SDLInput
+      Animate.Preview.SDLRenderer
+      Animate.Preview.State
+      Animate.Preview.Timer
+  other-modules:
+      Paths_animate_preview
+  default-language: Haskell2010
+
+executable animate-preview
+  main-is: Main.hs
+  hs-source-dirs:
+      executable
+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables OverloadedStrings DefaultSignatures MultiParamTypeClasses
+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N
+  build-depends:
+      animate-preview
+    , base >=4.7 && <5
+  other-modules:
+      Paths_animate_preview
+  default-language: Haskell2010
diff --git a/executable/Main.hs b/executable/Main.hs
new file mode 100644
--- /dev/null
+++ b/executable/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Animate.Preview
+
+main :: IO ()
+main = Animate.Preview.main
diff --git a/library/Animate/Preview.hs b/library/Animate/Preview.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+module Animate.Preview
+  ( main
+  ) where
+
+import qualified SDL
+import qualified SDL.Font as Font
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
+import Control.Monad.State (MonadState, StateT, evalStateT)
+import Control.Monad (when, forever, void)
+import Control.Concurrent (threadDelay, forkIO, newMVar)
+import Control.Exception.Safe (MonadThrow, MonadCatch)
+import Data.Maybe (fromMaybe)
+import Data.StateVar (get)
+import Options.Generic
+import System.FSNotify (withManager, watchDir, eventPath)
+import System.FilePath (takeDirectory, takeFileName)
+
+import Animate.Preview.Config
+import Animate.Preview.Logger
+import Animate.Preview.Loader
+import Animate.Preview.Renderer
+import Animate.Preview.SDLInput
+import Animate.Preview.SDLRenderer
+import Animate.Preview.ManagerInput
+import Animate.Preview.Resource
+import Animate.Preview.Runner
+import Animate.Preview.Scene
+import Animate.Preview.State
+import Animate.Preview.Timer
+
+data Options = Options
+  { target :: String  <?> "file path with sprite data (YAML or JSON)"
+  , image :: (Maybe String) <?> "Force sprite sheet image path"
+  , scale :: (Maybe Float) <?> "Scale the sprite size"
+  , highDpi :: Bool <?> "Use high DPI"
+  , watch :: Bool <?> "Watch files and reload on change"
+  } deriving (Show, Generic)
+
+instance ParseRecord Options where
+  parseRecord = parseRecordWithModifiers lispCaseModifiers
+
+main :: IO ()
+main = do
+  options <- getRecord "options"
+  let highDpi' = unHelpful $ highDpi options
+
+  SDL.initialize [SDL.InitVideo]
+  Font.initialize
+  window <- SDL.createWindow
+    "Animate Preview"
+    SDL.defaultWindow
+      { SDL.windowHighDPI = highDpi'
+      , SDL.windowResizable = True
+      }
+  renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
+  resources <- loadResources highDpi' renderer
+  loaded <- newMVar Nothing
+  current <- newMVar Nothing
+
+  winSize <- fmap fromIntegral <$> get (SDL.windowSize window)
+  drawSize <- fmap fromIntegral <$> SDL.glGetDrawableSize window
+
+  let settings = Settings
+        { sTarget = unHelpful $ target options
+        , sSpritesheet = unHelpful $ image options
+        , sScale = fromMaybe 1 (unHelpful $ scale options)
+        }
+
+  let cfg = Config
+        { cWindow = window
+        , cRenderer = renderer
+        , cResources = resources
+        , cHighDpi = highDpi' && (winSize /= drawSize)
+        , cSettings = settings
+        , cCurrent = current
+        , cLoaded = loaded
+        }
+
+  when (unHelpful $ watch options) $ do
+    runWatcherAndReloader cfg (sTarget settings)
+    case sSpritesheet settings of
+      Nothing -> return ()
+      Just imgPath -> runWatcherAndReloader cfg imgPath
+  
+  let v = initVars winSize drawSize
+  runAnimatePreview cfg v (reload >> mainLoop)
+  SDL.destroyWindow window
+  freeResources resources
+  Font.quit
+  SDL.quit
+
+runWatcherAndReloader :: Config -> String -> IO ()
+runWatcherAndReloader cfg filename = void $ forkIO $ withManager $ \mgr -> do
+  -- start a watching job (in the background)
+  void $ watchDir
+    mgr
+    (takeDirectory filename)
+    (\event -> takeFileName (eventPath event) == takeFileName filename)
+    (\_ -> runWatcher cfg reload)
+  -- sleep forever (until interrupted)
+  forever $ threadDelay 1000000
+
+newtype AnimatePreview a = AnimatePreview (ReaderT Config (StateT Vars IO) a)
+  deriving (Functor, Applicative, Monad, MonadReader Config, MonadState Vars, MonadIO, MonadThrow, MonadCatch)
+
+runAnimatePreview :: Config -> Vars -> AnimatePreview a -> IO a
+runAnimatePreview config v (AnimatePreview m) = evalStateT (runReaderT m config) v
+
+instance Logger AnimatePreview
+instance SDLRenderer AnimatePreview
+instance SDLInput AnimatePreview
+instance HasInput AnimatePreview
+instance Renderer AnimatePreview
+instance Scene AnimatePreview
+instance Loader AnimatePreview
+instance Timer AnimatePreview
+
+newtype Watcher a = Watcher (ReaderT Config IO a)
+  deriving (Functor, Applicative, Monad, MonadReader Config, MonadIO, MonadThrow, MonadCatch)
+
+instance Logger Watcher
+instance Loader Watcher
+
+runWatcher :: Config -> Watcher a -> IO a
+runWatcher cfg (Watcher m) = runReaderT m cfg
diff --git a/library/Animate/Preview/Animation.hs b/library/Animate/Preview/Animation.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Animation.hs
@@ -0,0 +1,17 @@
+module Animate.Preview.Animation where
+
+import qualified Animate
+import Text.Printf (printf)
+
+import Data.Aeson (FromJSON, ToJSON)
+
+type Animations key = Animate.Animations key (Animate.SpriteClip key) Seconds
+
+newtype Seconds = Seconds Float
+  deriving (Eq, Num, ToJSON, FromJSON, Fractional, Ord)
+
+instance Show Seconds where
+  show (Seconds s) = printf "%.3f" s ++ "s"
+
+clamp :: (Fractional a, Ord a) => a -> a -> a -> a
+clamp cur min' max' = if cur > max' then max' else (if cur < min' then min' else cur)
diff --git a/library/Animate/Preview/Color.hs b/library/Animate/Preview/Color.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Color.hs
@@ -0,0 +1,45 @@
+module Animate.Preview.Color where
+
+import Linear
+import Data.Word (Word8)
+
+data Mono
+  = Mono'Black
+  | Mono'Gray
+  | Mono'White
+  deriving (Show, Eq, Enum, Bounded)
+
+toggleMono :: Mono -> Mono
+toggleMono = \case
+  Mono'White -> Mono'Black
+  m -> succ m
+
+fromMono :: Mono -> (V4 Word8, V4 Word8)
+fromMono = \case
+  Mono'White -> (V4 0xff 0xff 0xff 0xff, V4 0xdd 0xdd 0xdd 0xff)
+  Mono'Gray -> (V4 0x88 0x88 0x88 0xff, V4 0x66 0x66 0x66 0xff)
+  Mono'Black -> (V4 0x22 0x22 0x22 0xff, V4 0x00 0x00 0x00 0xff)
+
+data Color
+  = Color'Red
+  | Color'Green
+  | Color'Blue
+  | Color'Magenta
+  | Color'Yellow
+  | Color'Cyan
+  deriving (Show, Eq, Enum, Bounded)
+
+fromColor :: Color -> V4 Word8
+fromColor = \case
+  Color'Red -> V4 0xff 0x00 0x00 0xff
+  Color'Green -> V4 0x00 0xff 0x00 0xff
+  Color'Blue -> V4 0x00 0x00 0xff 0xff
+  Color'Magenta -> V4 0xff 0x00 0xff 0xff
+  Color'Yellow -> V4 0xff 0xff 0x00 0xff
+  Color'Cyan -> V4 0x00 0xff 0xff 0xff
+
+toggleColors :: Maybe Color -> Maybe Color
+toggleColors Nothing = Just Color'Red
+toggleColors (Just c) = case c of
+    Color'Cyan -> Nothing
+    _ -> Just $ succ c
diff --git a/library/Animate/Preview/Config.hs b/library/Animate/Preview/Config.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Config.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE ConstraintKinds #-}
+module Animate.Preview.Config where
+
+import qualified SDL
+import qualified Animate
+import Data.Text (Text)
+import Control.Monad.Reader (MonadReader)
+import Control.Concurrent
+
+import Animate.Preview.Animation
+import Animate.Preview.Resource
+
+data Settings = Settings
+  { sTarget :: String
+  , sSpritesheet :: Maybe String
+  , sScale :: Float
+  }
+
+data Loaded = Loaded
+  { lTextToInt :: Text -> Maybe Int
+  , lIntToText :: Int -> Text
+  , lSpriteSheet :: Animate.SpriteSheet Int SDL.Texture Seconds
+  , lTotalKeys :: Int
+  }
+
+data Current = Current
+  { cPos :: Animate.Position Int Seconds
+  , cKeyName :: Text
+  } deriving (Show, Eq)
+
+data Config = Config
+  { cWindow :: SDL.Window
+  , cRenderer :: SDL.Renderer
+  , cResources :: Resources
+  , cHighDpi :: Bool
+  , cSettings :: Settings
+  , cCurrent :: MVar (Maybe Current)
+  , cLoaded :: MVar (Maybe Loaded)
+  }
+
+type R m = MonadReader Config m
diff --git a/library/Animate/Preview/Frame.hs b/library/Animate/Preview/Frame.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Frame.hs
@@ -0,0 +1,11 @@
+module Animate.Preview.Frame where
+
+frameDeltaSeconds :: Fractional a => a
+frameDeltaSeconds = 0.016667
+
+frameDeltaMilliseconds :: Int
+frameDeltaMilliseconds = 16
+
+msps, fps :: Int
+msps = 1000
+fps = 60
diff --git a/library/Animate/Preview/Input.hs b/library/Animate/Preview/Input.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Input.hs
@@ -0,0 +1,39 @@
+module Animate.Preview.Input where
+
+import KeyState
+import Linear
+
+data Input = Input
+  { iSpace :: KeyState Int
+  , iUp :: KeyState Int
+  , iDown :: KeyState Int
+  , iLeft :: KeyState Int
+  , iRight :: KeyState Int
+  , iPrevKeyFrame :: KeyState Int
+  , iNextKeyFrame :: KeyState Int
+  , iScaleReset :: KeyState Int
+  , iScaleMouseUp :: Int
+  , iScaleMouseDown :: Int
+  , iScaleUp :: KeyState Int
+  , iScaleDown :: KeyState Int
+  , iEscape :: KeyState Int
+  , iReload :: KeyState Int
+  , iOrigin :: KeyState Int
+  , iOutline :: KeyState Int
+  , iBackground :: KeyState Int
+  , iMousePos :: V2 Int
+  , iMouseClick :: KeyState Int
+  , iMouseMiddleClick :: KeyState Int
+  , iCenterOrigin :: KeyState Int
+  , iAccelReset :: KeyState Int
+  , iFaster :: KeyState Int
+  , iSlower :: KeyState Int
+  , iInfo :: KeyState Int
+  , iMode :: KeyState Int
+  , iQuit :: Bool
+  } deriving (Show, Eq)
+
+initInput :: Input
+initInput = Input a a a a a a a a 0 0 a a a a a a a (V2 0 0) a a a a a a a a False
+  where
+    a = initKeyState
diff --git a/library/Animate/Preview/Loader.hs b/library/Animate/Preview/Loader.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Loader.hs
@@ -0,0 +1,84 @@
+module Animate.Preview.Loader where
+
+import qualified Data.Map as Map
+import qualified Data.Vector as V
+import qualified SDL
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Applicative ((<|>))
+import Control.Monad.Reader (asks)
+import Control.Concurrent (modifyMVar_, readMVar)
+import Data.Text.Conversions (toText)
+import Data.Maybe (fromMaybe)
+import System.IO.Error
+
+import qualified Animate
+import Animate.Preview.Animation
+import Animate.Preview.Resource
+import Animate.Preview.Config
+import Animate.Preview.Logger
+
+class Monad m => Loader m where
+  load :: m Bool
+  default load :: (R m, MonadIO m, Logger m) => m Bool
+  load = do
+    ren <- asks cRenderer
+    target <- asks (sTarget . cSettings)
+    maybeForceImage <- asks (sSpritesheet . cSettings)
+    spriteSheetInfo <- liftIO $ catchIOError
+      (Just <$> Animate.readSpriteSheetInfoYAML target)
+      (const $ return Nothing)
+    case spriteSheetInfo :: Maybe (Animate.SpriteSheetInfo Int Seconds) of
+      Nothing -> do
+        setLoaded Nothing
+        logText $ "Not Loaded: " `mappend` toText target
+        return False
+      Just ssi -> do
+        let ssi' = ssi
+              { Animate.ssiImage = fromMaybe (Animate.ssiImage ssi) maybeForceImage
+              , Animate.ssiAlpha = Nothing <|> Animate.ssiAlpha ssi }
+        let animations = Animate.ssiAnimations ssi'
+        if Map.null animations
+          then do
+            setLoaded Nothing
+            logText $ "No Animations: " `mappend` toText target
+            return False
+          else do
+            tex' <- liftIO $ loadTexture ren (Animate.ssiImage ssi') (Animate.ssiAlpha ssi')
+            case tex' of
+              Nothing -> do
+                setLoaded Nothing
+                logText $ "No Image: " `mappend` toText (Animate.ssiImage ssi')
+                return False
+              Just tex -> do
+                let intToText i = fst $ Map.elemAt i animations
+                let textToInt t = Map.lookup t $ Map.fromList $ zip (map fst $ Map.toList animations) [0..]
+                let animations' = Animate.Animations $ V.fromList $ do
+                      (_  , frames) <- Map.toList animations
+                      return $ V.fromList $ do
+                        (frameIdx, delay) <- frames
+                        return $ Animate.Frame (Animate.ssiClips ssi' !! frameIdx) delay
+                let spriteSheet = Animate.SpriteSheet animations' tex
+                let totalKeys = V.length $ Animate.unAnimations animations'
+                let loaded = Loaded textToInt intToText spriteSheet totalKeys
+                setLoaded (Just loaded)
+                logText $ "Loaded: " `mappend` toText target
+                return True
+    where
+      loadTexture r path c = do
+        s' <- loadSurface' path c
+        case s' of
+          Nothing -> return Nothing
+          Just s -> do
+            t <- SDL.createTextureFromSurface r s
+            SDL.freeSurface s
+            return (Just t)
+
+setLoaded :: (R m, MonadIO m) => Maybe Loaded -> m ()
+setLoaded l = do
+  m <- asks cLoaded
+  liftIO $ modifyMVar_ m (\_ -> return l)
+
+getLoaded :: (R m, MonadIO m) => m (Maybe Loaded)
+getLoaded = do
+  m <- asks cLoaded
+  liftIO $ readMVar m
diff --git a/library/Animate/Preview/Logger.hs b/library/Animate/Preview/Logger.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Logger.hs
@@ -0,0 +1,14 @@
+module Animate.Preview.Logger where
+
+import qualified Data.Text.IO as T
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.Text (Text)
+
+class Monad m => Logger m where
+  logText :: Text -> m ()
+  default logText :: MonadIO m => Text -> m ()
+  logText = liftIO . T.putStrLn
+
+  logShow :: Show a => a -> m ()
+  default logShow :: (MonadIO m, Show a) => a -> m ()
+  logShow = liftIO . print
diff --git a/library/Animate/Preview/ManagerInput.hs b/library/Animate/Preview/ManagerInput.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/ManagerInput.hs
@@ -0,0 +1,81 @@
+module Animate.Preview.ManagerInput where
+
+import qualified SDL
+import Control.Monad.State
+import Control.Lens (view)
+import KeyState
+import Linear
+
+import Animate.Preview.Input
+import Animate.Preview.SDLInput
+import Animate.Preview.State
+
+class Monad m => HasInput m where
+  updateInput :: m ()
+  default updateInput :: (HasInput m, SDLInput m, MonadIO m) => m ()
+  updateInput = do
+    input <- getInput
+    events <- pollEventPayloads
+    mousePos <- getMousePos
+    mouseClick <- getMouseClick
+    middleClick <- getMouseMiddleClick
+    setInput (stepControl events (mouseClick, middleClick) input) { iMousePos = mousePos }
+
+  setInput :: Input -> m ()
+  default setInput :: S m => Input -> m ()
+  setInput input = modify (\v -> v { vInput = input })
+
+  getInput :: m Input
+  default getInput :: S m => m Input
+  getInput = gets vInput
+
+stepControl :: [SDL.EventPayload] -> (Bool, Bool) -> Input -> Input
+stepControl events (mouseClick, middleClick) i = i
+  { iSpace = next [SDL.KeycodeSpace] iSpace
+  , iUp = next [SDL.KeycodeUp, SDL.KeycodeK] iUp
+  , iDown = next [SDL.KeycodeDown, SDL.KeycodeJ] iDown
+  , iLeft = next [SDL.KeycodeLeft, SDL.KeycodeH] iLeft
+  , iRight = next [SDL.KeycodeRight, SDL.KeycodeL] iRight
+  , iPrevKeyFrame = next [SDL.KeycodeP] iPrevKeyFrame
+  , iNextKeyFrame = next [SDL.KeycodeN] iNextKeyFrame
+  , iScaleReset = next [SDL.KeycodeS] iScaleReset
+  , iScaleMouseUp = mouseEvent GT
+  , iScaleMouseDown = mouseEvent LT
+  , iScaleUp = next [SDL.KeycodePlus, SDL.KeycodeEquals] iScaleUp
+  , iScaleDown = next [SDL.KeycodeMinus] iScaleDown
+  , iEscape = next [SDL.KeycodeEscape] iEscape
+  , iReload = next [SDL.KeycodeR] iReload
+  , iOrigin = next [SDL.KeycodeT] iOrigin
+  , iOutline = next [SDL.KeycodeO] iOutline
+  , iBackground = next [SDL.KeycodeB] iBackground
+  , iMouseMiddleClick = updateKeyState 1 (iMouseMiddleClick i) middleClick
+  , iMouseClick = updateKeyState 1 (iMouseClick i) mouseClick
+  , iCenterOrigin = next [SDL.KeycodeC] iCenterOrigin
+  , iFaster = next [SDL.KeycodeF] iFaster
+  , iSlower = next [SDL.KeycodeD] iSlower
+  , iAccelReset = next [SDL.KeycodeA] iAccelReset
+  , iInfo = next [SDL.KeycodeI] iInfo
+  , iMode = next [SDL.KeycodeM] iMode
+  , iQuit = elem SDL.QuitEvent events
+  }
+  where
+    next xs f = nextKeystate events 1 xs (f i)
+    mouseEvent ordering = fromIntegral $ maximum $ (0:) $ flip map events $ \case
+      SDL.MouseWheelEvent dat -> let
+        scrollAmount = view _y $ SDL.mouseWheelEventPos dat
+        threshold = 0
+        in if abs scrollAmount > threshold
+          then case SDL.mouseWheelEventDirection dat of
+            SDL.ScrollNormal -> if compare scrollAmount 0 == ordering then abs scrollAmount else 0
+            SDL.ScrollFlipped -> if compare 0 scrollAmount == ordering then abs scrollAmount else 0
+          else 0
+      _ -> 0
+
+nextKeystate :: [SDL.EventPayload] -> Int -> [SDL.Keycode] -> KeyState Int -> KeyState Int
+nextKeystate events count keycodes keystate
+  | or $ map pressed keycodes = pressedKeyState
+  | or $ map released keycodes = releasedKeyState
+  | otherwise = maintainKeyState count keystate
+  where
+    released keycode = or $ map (keycodeReleased keycode) events
+    pressed keycode = or $ map (keycodePressed keycode) events
diff --git a/library/Animate/Preview/Mode.hs b/library/Animate/Preview/Mode.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Mode.hs
@@ -0,0 +1,6 @@
+module Animate.Preview.Mode where
+
+data Mode
+  = Mode'Playback
+  | Mode'Stepper
+  deriving (Show, Eq)
diff --git a/library/Animate/Preview/Renderer.hs b/library/Animate/Preview/Renderer.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Renderer.hs
@@ -0,0 +1,153 @@
+module Animate.Preview.Renderer where
+
+import qualified Animate
+import qualified SDL
+import qualified SDL.Primitive as Gfx
+import qualified Data.Map as Map
+import Foreign.C.Types
+import SDL.Vect
+import Control.Monad.Reader (asks)
+import Control.Monad.State (modify)
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.Maybe (fromMaybe)
+import Data.StateVar (($=))
+import Foreign.C.Types (CFloat(..))
+import Data.Text (Text)
+import Data.Text.Conversions (fromText)
+import Data.StateVar (get)
+import Data.List (foldl')
+
+import Animate.Preview.Config
+import Animate.Preview.Resource
+import Animate.Preview.Animation
+import Animate.Preview.Color
+import Animate.Preview.SDLRenderer
+import Animate.Preview.State
+
+class Monad m => Renderer m where
+  updateScreenInfo :: m ()
+  default updateScreenInfo :: (R m, S m, MonadIO m) => m ()
+  updateScreenInfo = do
+    w <- asks cWindow
+    winSize <- liftIO $ get (SDL.windowSize w)
+    drawSize <- liftIO $ SDL.glGetDrawableSize w
+    modify $ \v -> v { vDrawSize = fromIntegral <$> drawSize, vWinSize = fromIntegral <$> winSize }
+
+  clearScreen :: m ()
+  default clearScreen :: (SDLRenderer m, R m) => m ()
+  clearScreen = do
+    renderer <- asks cRenderer
+    clearRenderer renderer
+
+  drawScreen :: m ()
+  default drawScreen :: (SDLRenderer m, R m) => m ()
+  drawScreen = do
+    renderer <- asks cRenderer
+    presentRenderer renderer
+
+  drawBackground :: V2 Int -> Mono -> m ()
+  default drawBackground :: (SDLRenderer m, R m, MonadIO m) => V2 Int -> Mono -> m ()
+  drawBackground (V2 w h) mono = do
+    renderer <- asks cRenderer
+    let (lite, dark) = fromMono mono
+    let indices = do
+          x <- [0..(w `div` 10)]
+          y <- [0..(h `div` 10)]
+          let x0 = x * 10
+              x1 = x * 10 + 10
+          let y0 = y * 10
+              y1 = y * 10 + 10
+          let color = if (x + y) `mod` 2 == 0 then lite else dark
+          return (V2 x0 y0, V2 x1 y1, color) 
+    flip mapM_ indices $ \(a,b,c) ->
+      liftIO $ Gfx.fillRectangle renderer (fromIntegral <$> a) (fromIntegral <$> b) c
+  
+  drawAniSprite :: Animate.SpriteSheet Int SDL.Texture Seconds -> Maybe Color -> Float -> Animate.SpriteClip Int -> (Int, Int) -> m ()
+  default drawAniSprite :: (SDLRenderer m, R m, MonadIO m) => Animate.SpriteSheet Int SDL.Texture Seconds -> Maybe Color -> Float -> Animate.SpriteClip Int -> (Int, Int) -> m ()
+  drawAniSprite as = drawSprite (const as)
+
+  drawCrosshair :: (Int, Int) -> Color -> m ()
+  default drawCrosshair :: (MonadIO m, R m) => (Int, Int) -> Color -> m ()
+  drawCrosshair (x,y) color = do
+    ren <- asks cRenderer
+    let radius = 8
+    let diameter = fromIntegral $ radius * 2
+    liftIO $ do
+      let color' = fromColor color
+      Gfx.horizontalLine ren (fromIntegral <$> V2 (x - radius) y) diameter color'
+      Gfx.verticalLine ren (fromIntegral <$> V2 x (y - radius)) diameter color'
+
+  drawText :: (Int, Int) -> Text -> m ()
+  default drawText :: (SDLRenderer m, R m, MonadIO m) => (Int, Int) -> Text -> m ()
+  drawText xy text = do
+    glyphMap <- asks (rGlyphMap . cResources)
+    glyphSize <- asks (rGlyphSize . cResources)
+    let instructions = buildGlyphIntructions glyphSize glyphMap (fromText text)
+    let (x,y) = xy
+    flip mapM_ instructions $ \(tex, (x',y')) -> do
+      let xy' = (x + x', y + y')
+      drawTextureSprite (const tex) xy'
+
+buildGlyphIntructions :: Int -> Map.Map Char Glyph -> [Char] -> [(SDL.Texture, (Int, Int))]
+buildGlyphIntructions _glyphSize glyphMap str = fst $ foldl' appendGlyph ([], (0,0)) str
+  where
+    appendGlyph
+      :: ([(SDL.Texture, (Int, Int))], (Int,Int))
+      -> Char
+      -> ([(SDL.Texture, (Int, Int))], (Int,Int)) 
+    appendGlyph (glyphs, (x,y)) ch = case Map.lookup ch glyphMap of
+      Nothing -> (glyphs, (x,y))
+      Just glyph -> let
+        tex = gTexture glyph
+        (xmin, _xmax, _ymin, _ymax, adv) = gMetrics glyph
+        x' = x + xmin
+        y' = y
+        in ((tex, (x', y')) : glyphs, (x + xmin + adv, y))
+
+drawTextureSprite :: (SDLRenderer m, R m) => (Config -> SDL.Texture) -> (Int, Int) -> m ()
+drawTextureSprite getTex (x,y) = do
+  renderer <- asks cRenderer
+  tex <- asks getTex
+  SDL.TextureInfo{textureWidth,textureHeight} <- queryTexture tex
+  let dim = V2 textureWidth textureHeight
+  drawTexture
+    renderer
+    tex
+    Nothing
+    (Just $ SDL.Rectangle (SDL.P $ SDL.V2 (fromIntegral x) (fromIntegral y)) dim)
+
+drawSprite :: (SDLRenderer m, R m, MonadIO m) => (Config -> Animate.SpriteSheet key SDL.Texture Seconds) -> Maybe Color -> Float -> Animate.SpriteClip key -> (Int, Int) -> m ()
+drawSprite ss outline scalar' clip (x,y) = do
+  let scalar = pure (CFloat scalar')
+  renderer <- asks cRenderer
+  sheet <- asks (Animate.ssImage . ss)
+  let scaleDown n = fmap round $ (fmap fromIntegral n) / scalar
+  let scaleUp n = fmap round $ (fmap fromIntegral n) * scalar
+  let clip'@(SDL.Rectangle _ dim) = rectFromClip clip
+  let offset = offsetFromClip clip
+  let loc = (+) <$> offset <*> (scaleDown $ V2 x y)
+  case outline of
+    Nothing -> return ()
+    Just outline' -> liftIO $ Gfx.rectangle renderer (scaleUp loc) (scaleUp $ loc + dim) (fromColor outline')
+  -- set scale for sprite
+  liftIO $ SDL.rendererScale renderer $= scalar
+  drawTexture
+    renderer
+    sheet
+    (Just clip')
+    (Just $ SDL.Rectangle (SDL.P loc) dim)
+  -- reset scale from sprite
+  liftIO $ SDL.rendererScale renderer $= (V2 1 1)
+
+getSpriteAnimations :: R m => (Config -> Animate.SpriteSheet key SDL.Texture Seconds) -> m (Animations key)
+getSpriteAnimations ss = asks (Animate.ssAnimations . ss)
+
+rectFromClip :: Animate.SpriteClip key -> SDL.Rectangle CInt
+rectFromClip Animate.SpriteClip{scX,scY,scW,scH} = SDL.Rectangle (SDL.P (V2 (num scX) (num scY))) (V2 (num scW) (num scH))
+  where
+    num = fromIntegral
+
+offsetFromClip :: Animate.SpriteClip key -> V2 CInt
+offsetFromClip Animate.SpriteClip{scOffset} = fromMaybe
+  (V2 0 0)
+  ((\(x,y) -> fromIntegral <$> V2 (-x) (-y)) <$> scOffset)
diff --git a/library/Animate/Preview/Resource.hs b/library/Animate/Preview/Resource.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Resource.hs
@@ -0,0 +1,109 @@
+module Animate.Preview.Resource where
+
+import qualified SDL
+import qualified SDL.Font as Font
+import qualified SDL.Image as Image
+import qualified Animate
+import qualified SDL.Raw.Video as Raw
+import qualified SDL.Internal.Numbered as Numbered
+import qualified Data.Map as Map
+import Control.Monad (filterM)
+import Data.Text (Text)
+import Data.Maybe (catMaybes)
+import Data.StateVar (($=))
+import SDL.Vect
+import System.IO.Error (catchIOError)
+import Paths_animate_preview (getDataFileName)
+
+data Resources = Resources
+  { rFont :: Font.Font
+  , rGlyphMap :: Map.Map Char Glyph
+  , rGlyphSize :: Int
+  }
+
+data Glyph = Glyph
+  { gChar :: Char
+  , gMetrics :: (Int, Int, Int, Int, Int)
+  , gTexture :: SDL.Texture
+  }
+
+-- | Produce a new 'SDL.Surface' based on an existing one, but
+-- optimized for blitting to the specified 'SDL.PixelFormat'.
+convertSurface :: SDL.Surface -> SDL.PixelFormat -> IO SDL.Surface
+convertSurface (SDL.Surface s _) pixFmt = do
+  fmt <- Raw.allocFormat (Numbered.toNumber pixFmt)
+  surface <- SDL.Surface <$> Raw.convertSurface s fmt 0 <*> pure Nothing
+  surface <$ Raw.freeFormat fmt
+
+loadSurface' :: FilePath -> Maybe Animate.Color -> IO (Maybe SDL.Surface)
+loadSurface' path alpha = do
+  surface0' <- catchIOError
+    (Just <$> Image.load path)
+    (const $ return Nothing)
+  case surface0' of
+    Nothing -> return Nothing
+    Just surface0 -> do
+      surface <- convertSurface surface0 SDL.RGBA8888
+      SDL.freeSurface surface0
+      case alpha of
+        Just (r,g,b) -> SDL.surfaceColorKey surface $= (Just $ V4 r g b 0x00)
+        Nothing -> return ()
+      return (Just surface)
+
+alphaColorDef :: Animate.Color
+alphaColorDef = (0xff,0x00,0xff)
+
+createText :: Bool -> SDL.Renderer -> Font.Font -> Text -> IO SDL.Texture
+createText highDpi ren font text = do
+  Font.setHinting font Font.None
+  Font.setOutline font (if highDpi then 4 else 2)
+  outline <- Font.solid font (V4 0 0 0 0) text
+  Font.setOutline font 0
+  inline <- Font.solid font (V4 255 255 255 255) text
+  _ <- SDL.surfaceBlit inline Nothing outline (Just $ SDL.P (if highDpi then 4 else 2))
+  tex <- SDL.createTextureFromSurface ren outline
+  SDL.freeSurface inline
+  SDL.freeSurface outline
+  return tex
+
+createGlyph :: Bool -> SDL.Renderer -> Font.Font -> Char -> IO (Maybe Glyph)
+createGlyph highDpi ren font ch = do
+  metrics' <- Font.glyphMetrics font ch
+  --
+  case metrics' of
+    Nothing -> return Nothing
+    Just metrics@(xmin, xmax, _ymin, _ymax, _adv) -> do
+      if (xmax - xmin > 0) || ch == ' '
+        then do
+          Font.setHinting font Font.None
+          Font.setOutline font (if highDpi then 4 else 2)
+          outline <- Font.solidGlyph font (V4 0 0 0 0) ch
+          Font.setOutline font 0
+          inline <- Font.solidGlyph font (V4 255 255 255 255) ch
+          _ <- SDL.surfaceBlit inline Nothing outline (Just $ SDL.P (if highDpi then 4 else 2))
+          tex <- SDL.createTextureFromSurface ren outline
+          SDL.freeSurface inline
+          SDL.freeSurface outline
+          --
+          return . Just $ Glyph ch metrics tex
+        else return Nothing
+
+loadResources :: Bool -> SDL.Renderer -> IO Resources
+loadResources highDpi ren = do
+  fileName <- getDataFileName "resource/ProggyClean.ttf"
+  let glyphSize = if highDpi then 32 else 16
+  font <- Font.load fileName glyphSize
+  putStrLn "Font cache: filtering glyphs"
+  availableChars <- filterM (Font.glyphProvided font) [minBound..maxBound]
+  putStrLn "Font cache: creating textures"
+  glyphs <- mapM (createGlyph highDpi ren font) (' ':availableChars)
+  let glyphs' = map (\g -> (gChar g, g)) (catMaybes glyphs)
+  return Resources
+    { rFont = font
+    , rGlyphMap = Map.fromList glyphs'
+    , rGlyphSize = glyphSize
+    }
+
+freeResources :: Resources -> IO ()
+freeResources r = do
+  Font.free (rFont r)
diff --git a/library/Animate/Preview/Runner.hs b/library/Animate/Preview/Runner.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Runner.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Animate.Preview.Runner where
+
+import Control.Monad (unless)
+import Control.Monad.State (gets)
+import KeyState
+
+import Animate.Preview.Config
+import Animate.Preview.Logger
+import Animate.Preview.Renderer
+import Animate.Preview.Input
+import Animate.Preview.Scene
+import Animate.Preview.ManagerInput
+import Animate.Preview.State
+import Animate.Preview.Timer
+
+mainLoop :: (R m, S m, Logger m, Renderer m, HasInput m, Scene m, Timer m) => m ()
+mainLoop = do
+  ticks <- startTicks
+  updateScreenInfo
+  drawSize <- gets vDrawSize
+  background <- gets vBackground
+  updateInput
+  input <- getInput
+  clearScreen
+  drawBackground drawSize background
+  sceneStep
+  drawScreen
+  let quit = iQuit input || ksStatus (iEscape input) == KeyStatus'Pressed
+  delayTicks ticks
+  unless quit mainLoop
diff --git a/library/Animate/Preview/SDLInput.hs b/library/Animate/Preview/SDLInput.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/SDLInput.hs
@@ -0,0 +1,52 @@
+module Animate.Preview.SDLInput where
+
+import qualified SDL
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State (gets)
+import Linear
+
+import Animate.Preview.State
+
+keycodePressed :: SDL.Keycode -> SDL.EventPayload -> Bool
+keycodePressed keycode event = case event of
+  SDL.KeyboardEvent SDL.KeyboardEventData{keyboardEventKeysym = SDL.Keysym{keysymKeycode = code}, keyboardEventKeyMotion = motion, keyboardEventRepeat } ->
+    code == keycode &&
+    motion == SDL.Pressed &&
+    not keyboardEventRepeat
+  _ -> False
+
+keycodeReleased :: SDL.Keycode -> SDL.EventPayload -> Bool
+keycodeReleased keycode event = case event of
+  SDL.KeyboardEvent SDL.KeyboardEventData{keyboardEventKeysym = SDL.Keysym{keysymKeycode = code}, keyboardEventKeyMotion = motion, keyboardEventRepeat } ->
+    code == keycode &&
+    motion == SDL.Released &&
+    not keyboardEventRepeat
+  _ -> False
+
+class Monad m => SDLInput m where
+  pollEventPayloads :: m [SDL.EventPayload]
+  default pollEventPayloads :: MonadIO m => m [SDL.EventPayload]
+  pollEventPayloads = liftIO $ map SDL.eventPayload <$> SDL.pollEvents
+
+  getMousePos :: m (V2 Int)
+  default getMousePos :: (S m, MonadIO m) => m (V2 Int)
+  getMousePos = do
+    drawSize <- gets vDrawSize
+    winSize <- gets vWinSize
+    SDL.P pos <- liftIO SDL.getAbsoluteMouseLocation
+    let pos' = div <$> ((*) <$> drawSize <*> (fmap fromIntegral pos)) <*> winSize
+    return $ fmap fromIntegral pos'
+
+  getMouseClick :: m Bool
+  default getMouseClick :: MonadIO m => m Bool
+  getMouseClick = do
+    test <- liftIO SDL.getMouseButtons
+    return $ test (SDL.ButtonExtra 0)
+    -- There's an offby one bug in `sdl2` which doesn't test SDL.ButtonLeft as expected
+    -- It has been since fixed but not uploaded to hackage: https://github.com/haskell-game/sdl2/commit/eb7accdc2ae6349f262e758a93e5c62ee75d0e14
+
+  getMouseMiddleClick :: m Bool
+  default getMouseMiddleClick :: MonadIO m => m Bool
+  getMouseMiddleClick = do
+    test <- liftIO SDL.getMouseButtons
+    return $ test (SDL.ButtonExtra 1) -- Same comment as above
diff --git a/library/Animate/Preview/SDLRenderer.hs b/library/Animate/Preview/SDLRenderer.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/SDLRenderer.hs
@@ -0,0 +1,27 @@
+module Animate.Preview.SDLRenderer where
+
+import qualified SDL
+import Data.StateVar (($=))
+import Control.Monad.IO.Class (MonadIO(..))
+import Foreign.C.Types
+import SDL.Vect
+import Control.Monad (void)
+
+class Monad m => SDLRenderer m where
+  presentRenderer :: SDL.Renderer -> m ()
+  default presentRenderer :: MonadIO m => SDL.Renderer -> m ()
+  presentRenderer = SDL.present
+
+  clearRenderer :: SDL.Renderer -> m ()
+  default clearRenderer :: MonadIO m => SDL.Renderer -> m ()
+  clearRenderer ren = do
+    SDL.rendererDrawColor ren $= V4 0x00 0x00 0x00 0xff
+    liftIO $ void $ SDL.clear ren
+
+  queryTexture :: SDL.Texture -> m SDL.TextureInfo
+  default queryTexture ::  MonadIO m => SDL.Texture -> m SDL.TextureInfo
+  queryTexture = SDL.queryTexture
+
+  drawTexture :: SDL.Renderer -> SDL.Texture -> Maybe (SDL.Rectangle CInt)-> Maybe (SDL.Rectangle CInt) -> m ()
+  default drawTexture :: MonadIO m => SDL.Renderer -> SDL.Texture -> Maybe (SDL.Rectangle CInt) -> Maybe (SDL.Rectangle CInt) -> m ()
+  drawTexture renderer tex maybeClip maybeLoc = SDL.copy renderer tex maybeClip maybeLoc
diff --git a/library/Animate/Preview/Scalar.hs b/library/Animate/Preview/Scalar.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Scalar.hs
@@ -0,0 +1,43 @@
+module Animate.Preview.Scalar where
+
+data Scalar
+  = Scalar'None
+  | Scalar'Down Int
+  | Scalar'Up Int
+  deriving (Show, Eq)
+
+scalarToSeconds :: Scalar -> Float
+scalarToSeconds = \case
+  Scalar'None -> 1
+  Scalar'Down n -> 1 - (0.1 * fromIntegral n)
+  Scalar'Up n -> 1 + (0.5 * fromIntegral n)
+
+asSpeedString :: Scalar -> String
+asSpeedString = \case
+  Scalar'None -> "1x"
+  Scalar'Down n -> "0." ++ show (10 - n) ++ "x"
+  Scalar'Up n -> show (n `div` 2 + 1) ++ "." ++ (if mod n 2 == 0 then  "0" else "5") ++ "x"
+
+scalarToSpriteScale :: Scalar -> Float
+scalarToSpriteScale = \case
+  Scalar'None -> 1
+  Scalar'Down n -> 1 - (0.1 * fromIntegral n)
+  Scalar'Up n -> 1 + (0.1 * fromIntegral n)
+
+asScaleString :: Scalar -> String
+asScaleString = \case
+  Scalar'None -> "1x"
+  Scalar'Down n -> "0." ++ show (10 - n) ++ "x"
+  Scalar'Up n -> show (n `div` 10 + 1) ++ "." ++ show (mod n 10) ++ "x"
+
+incrementScalar :: Int -> Scalar -> Scalar
+incrementScalar upper = \case
+  Scalar'None -> Scalar'Up 1
+  Scalar'Up n -> Scalar'Up (min upper (n + 1))
+  Scalar'Down n -> if n <= 1 then Scalar'None else Scalar'Down (n - 1)
+
+decrementScalar :: Int -> Scalar -> Scalar
+decrementScalar lower = \case
+  Scalar'None -> Scalar'Down 1
+  Scalar'Down n -> Scalar'Down (min lower (n + 1))
+  Scalar'Up n -> if n <= 1 then Scalar'None else Scalar'Up (n - 1)
diff --git a/library/Animate/Preview/Scene.hs b/library/Animate/Preview/Scene.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Scene.hs
@@ -0,0 +1,309 @@
+module Animate.Preview.Scene where
+
+import qualified Animate
+import qualified Data.Vector as V
+import Control.Concurrent (readMVar, modifyMVar_)
+import Control.Monad (when)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Reader (asks)
+import Control.Monad.State (modify, gets)
+import Data.Text.Conversions (toText, fromText)
+import KeyState
+import Linear
+
+import Animate.Preview.Animation
+import Animate.Preview.Config
+import Animate.Preview.Renderer
+import Animate.Preview.Input
+import Animate.Preview.Frame
+import Animate.Preview.State
+import Animate.Preview.ManagerInput
+import Animate.Preview.Color
+import Animate.Preview.Logger
+import Animate.Preview.Scalar
+import Animate.Preview.Mode
+import Animate.Preview.Loader
+
+class Monad m => Scene m where
+  sceneStep :: m ()
+  default sceneStep :: (R m, S m, Renderer m, HasInput m, Logger m, Loader m, MonadIO m) => m ()
+  sceneStep = do
+    updateMode
+    updateReload
+    toggleVisuals
+    updateOrigin
+    updateKeyFrame
+    updateSpeed
+    updateScale
+    updateInfo
+    updateAnimation
+    drawScene
+
+updateKeyFrame :: (R m, HasInput m, MonadIO m) => m ()
+updateKeyFrame = do
+  input <- getInput
+  loaded' <- getLoaded 
+  case loaded' of
+    Nothing -> return ()
+    Just loaded -> do
+      let animations = (Animate.ssAnimations . lSpriteSheet) loaded
+      when (isPressed $ iNextKeyFrame input) $ modifyCurrent' $ \c -> let
+        key = unsafeNextKey (Animate.pKey $ cPos c) animations
+        keyName = lIntToText loaded key
+        in Current (Animate.initPosition key) keyName
+      when (isPressed $ iPrevKeyFrame input) $ modifyCurrent' $ \c -> let
+        key = unsafePrevKey (Animate.pKey $ cPos c) animations
+        keyName = lIntToText loaded key
+        in Current (Animate.initPosition key) keyName
+
+unsafeNextKey :: Int -> Animate.Animations a b c -> Int
+unsafeNextKey n (Animate.Animations a) = (1 + n) `mod` (V.length a)
+
+unsafePrevKey :: Int -> Animate.Animations a b c -> Int
+unsafePrevKey n (Animate.Animations a) = (n - 1) `mod` (V.length a)
+
+updateMode :: (S m, HasInput m) => m ()
+updateMode = do
+  input <- getInput
+  when (onceThenFire $ iMode input) $ modify $ \v -> v { vMode = if vMode v == Mode'Playback then Mode'Stepper else Mode'Playback }
+
+updateReload :: (S m, R m, HasInput m, Loader m, MonadIO m) => m ()
+updateReload = do
+  input <- getInput
+  when (isPressed $ iReload input)reload
+
+reload :: (R m, Loader m, MonadIO m) => m ()
+reload = do
+  _ <- load
+  loaded' <- getLoaded
+  case loaded' of
+    Nothing -> return ()
+    Just loaded -> do
+      modifyCurrent $ \current ->
+        case current of
+          Nothing -> Just $ Current (Animate.initPosition 0) (lIntToText loaded 0)
+          Just c -> Just $ reloadCurrent loaded c
+
+reloadCurrent :: Loaded -> Current -> Current
+reloadCurrent l c
+  | lIntToText l (Animate.pKey . cPos $ c) == cKeyName c = case lTextToInt l (cKeyName c) of
+      Nothing -> reset
+      Just k -> c
+        { cPos = (cPos c)
+            { Animate.pKey = k
+            , Animate.pFrameIndex = mod
+                (Animate.pFrameIndex (cPos c))
+                (V.length $ Animate.framesByAnimation (Animate.ssAnimations $ lSpriteSheet l) k)
+            , Animate.pCounter = 0
+            }
+        }
+  | otherwise = reset
+  where
+    reset = Current (Animate.initPosition 0) (lIntToText l 0)
+
+updateAnimation :: (R m, S m, Renderer m, HasInput m, MonadIO m) => m ()
+updateAnimation = do
+  mode <- gets vMode
+  loaded' <- getLoaded 
+  case loaded' of
+    Nothing -> return ()
+    Just loaded -> do
+      let animations = (Animate.ssAnimations . lSpriteSheet) loaded
+      current' <- getCurrent
+      case current' of
+        Nothing -> return ()
+        Just Current{cPos=pos} -> case mode of
+          Mode'Stepper -> do
+            input <- getInput
+            when (onceThenFire $ iFaster input) $ modifyCurrent' $ \c -> c { cPos = forceNextFrameIndex animations pos }
+            when (onceThenFire $ iSlower input) $ modifyCurrent' $ \c -> c { cPos = forcePrevFrameIndex animations pos }
+          Mode'Playback -> do
+            accel <- gets vAccel
+            let accelScalar = scalarToSeconds accel
+            let pos' = Animate.stepPosition animations pos (frameDeltaSeconds * (Seconds accelScalar))
+            modifyCurrent' $ \c -> c { cPos = pos' }
+
+unsafeForceNextFrameIndex :: V.Vector (Animate.Frame loc delay) -> Animate.FrameIndex -> Animate.FrameIndex
+unsafeForceNextFrameIndex frames idx = if idx + 1 >= len then 0 else idx + 1
+  where len = V.length frames
+
+unsafeForcePrevFrameIndex :: V.Vector (Animate.Frame loc delay) -> Animate.FrameIndex -> Animate.FrameIndex
+unsafeForcePrevFrameIndex frames idx = if idx <= 0 then len - 1 else idx - 1
+  where len = V.length frames
+
+forceNextFrameIndex :: Enum key => Animate.Animations key loc delay -> Animate.Position key delay -> Animate.Position key delay
+forceNextFrameIndex a p = p { Animate.pFrameIndex = unsafeForceNextFrameIndex frames (Animate.pFrameIndex p) }
+  where
+    frames = Animate.framesByAnimation a (Animate.pKey p)
+
+forcePrevFrameIndex :: Enum key => Animate.Animations key loc delay -> Animate.Position key delay -> Animate.Position key delay
+forcePrevFrameIndex a p = p { Animate.pFrameIndex = unsafeForcePrevFrameIndex frames (Animate.pFrameIndex p) }
+  where
+    frames = Animate.framesByAnimation a (Animate.pKey p)
+
+updateSpeed :: (S m, HasInput m) => m ()
+updateSpeed = do
+  input <- getInput
+  mode <- gets vMode
+  case mode of
+    Mode'Stepper -> return ()
+    Mode'Playback ->  do
+      let up = onceThenFire (iFaster input) 
+      let down = onceThenFire (iSlower input)
+      let reset = isPressed (iAccelReset input)
+      let change s
+            | reset = Scalar'None
+            | up && not down = incrementScalar 18 s
+            | down && not up = decrementScalar 9 s
+            | otherwise = s
+      modify $ \v -> v { vAccel = change (vAccel v) }
+
+onceThenFire :: KeyState Int -> Bool
+onceThenFire ks = isPressed ks || (isHeld ks && counterGreater 20 ks)
+
+counterGreater :: Int -> KeyState Int -> Bool  
+counterGreater n ks = case ksCounter ks of
+  Nothing -> False
+  Just counter -> counter > n
+
+updateInfo :: (S m, HasInput m) => m ()
+updateInfo = do
+  input <- getInput
+  when (onceThenFire $ iInfo input) $ modify $ \v -> v { vInfoShown = not (vInfoShown v) }
+
+updateScale :: (S m, HasInput m) => m ()
+updateScale = do
+  input <- getInput
+  let up = onceThenFire (iScaleUp input) || iScaleMouseUp input > 0
+  let down = onceThenFire (iScaleDown input) || iScaleMouseDown input > 0
+  let reset = isPressed (iScaleReset input) || isPressed (iMouseMiddleClick input)
+  let increment = replicate (max 1 (iScaleMouseUp input)) (incrementScalar 90)
+  let decrement = replicate (max 1 (iScaleMouseDown input)) (decrementScalar 9)
+  let change s
+        | reset = Scalar'None
+        | up && not down = fapply increment s
+        | down && not up = fapply decrement s
+        | otherwise = s
+  modify $ \v -> v { vScale = change (vScale v) }
+
+modifyCurrent' :: (R m, MonadIO m) => (Current -> Current) -> m ()
+modifyCurrent' f = do
+  m <- asks cCurrent
+  liftIO $ modifyMVar_ m (\c -> return $ fmap f c)
+
+modifyCurrent :: (R m, MonadIO m) => (Maybe Current -> Maybe Current) -> m ()
+modifyCurrent f = do
+  m <- asks cCurrent
+  liftIO $ modifyMVar_ m (\c -> return $ f c)
+
+setCurrent :: (R m, MonadIO m) => Maybe Current -> m ()
+setCurrent c = do
+  m <- asks cCurrent
+  liftIO $ modifyMVar_ m (\_ -> return c)
+
+getCurrent :: (R m, MonadIO m) => m (Maybe Current)
+getCurrent = do
+  m <- asks cCurrent
+  liftIO $ readMVar m
+
+fapply :: [a -> a] -> a -> a
+fapply xs a = case xs of [] -> a; (y:ys) -> fapply ys (y a)
+
+updateOrigin :: (R m, S m, HasInput m) => m ()
+updateOrigin = do
+  input <- getInput
+  -- Move with keys
+  let d = 5
+  when (onceThenFire $ iUp input) $ modify $ \v -> v { vOrigin = vOrigin v + V2 0 (-d) }
+  when (onceThenFire $ iDown input) $ modify $ \v -> v { vOrigin = vOrigin v + V2 0 d }
+  when (onceThenFire $ iLeft input) $ modify $ \v -> v { vOrigin = vOrigin v + V2 (-d) 0 }
+  when (onceThenFire $ iRight input) $ modify $ \v -> v { vOrigin = vOrigin v + V2 d 0 }
+  -- Recenter origin
+  when (isPressed $ iCenterOrigin input) $ do
+    drawSize <- gets vDrawSize
+    modify $ \v -> v { vOrigin = div <$> drawSize <*> 2 }
+  -- Origin by mouse click
+  when (isTouched $ iMouseClick input) $ modify $ \v -> v
+   { vOrigin = iMousePos input }
+
+toggleVisuals :: (S m, HasInput m) => m ()
+toggleVisuals = do
+  input <- getInput
+  let toggleBackground = isPressed (iBackground input)
+  let toggleOrigin = isPressed (iOrigin input)
+  let toggleOutline = isPressed (iOutline input)
+  modify $ (\v -> v
+    { vBackground = (if toggleBackground then toggleMono else id) (vBackground v)
+    , vOriginColor = (if toggleOrigin then toggleColors else id) (vOriginColor v)
+    , vOutlineColor = (if toggleOutline then toggleColors else id) (vOutlineColor v)
+    })
+
+drawScene :: (R m, S m, Renderer m, HasInput m, MonadIO m) => m ()
+drawScene = do
+  V2 x y <- gets vOrigin
+  current <- getCurrent
+  originColor <- gets vOriginColor
+  outlineColor <- gets vOutlineColor
+  accel <- gets vAccel
+  mode <- gets vMode
+  infoShown <- gets vInfoShown
+  scale <- gets vScale
+  let scalar = scalarToSpriteScale scale
+  loaded' <- getLoaded 
+  highDpi <- asks cHighDpi
+  let lineSpacing = lineSpacing' highDpi
+  case loaded' of
+    Nothing -> when infoShown $ do
+      drawText (ofsX, ofsY + lineSpacing * 4)  $ toText $ concat ["Anim:"]
+      drawText (ofsX, ofsY + lineSpacing * 5)  $ toText $ concat ["  Key:"]
+      drawText (ofsX, ofsY + lineSpacing * 6)  $ toText $ concat ["  Time:"]
+      drawText (ofsX, ofsY + lineSpacing * 7)  $ toText $ concat ["Pos:"]
+      drawText (ofsX, ofsY + lineSpacing * 8)  $ toText $ concat ["  Frame:"]
+      drawText (ofsX, ofsY + lineSpacing * 9)  $ toText $ concat ["  Time:"]
+      drawText (ofsX, ofsY + lineSpacing * 10) $ toText $ concat ["  Points:"]
+      drawText (ofsX, ofsY + lineSpacing * 11) $ toText $ concat ["  Size:"]
+      drawText (ofsX, ofsY + lineSpacing * 12) $ toText $ concat ["  Offset: "]
+    Just loaded -> do
+      case current of
+        Nothing -> return ()
+        Just c -> do
+          let pos = cPos c
+          let animations = (Animate.ssAnimations . lSpriteSheet) loaded
+          let frames = Animate.framesByAnimation animations (Animate.pKey pos)
+          let frame = frames V.! Animate.pFrameIndex pos
+          let frameDelay = Animate.fDelay frame
+          let frameClip = Animate.fLocation frame
+          let (x0,y0) = (Animate.scX frameClip, Animate.scY frameClip)
+          let (w,h) = (Animate.scW frameClip, Animate.scH frameClip)
+          let (x1,y1) = (x0 + w, y0 + h)
+          let framesLen = V.length frames
+          let totalSeconds = sum $ map Animate.fDelay (V.toList frames)
+          let loc = Animate.currentLocation animations pos
+          drawAniSprite (lSpriteSheet loaded) outlineColor scalar loc (x, y)
+          when infoShown $ do
+            let keyName = cKeyName c
+            drawText (ofsX, ofsY + lineSpacing * 4)  $ toText $ concat ["Anim:"]
+            drawText (ofsX, ofsY + lineSpacing * 5)  $ toText $ concat ["  Key: \"", fromText keyName, "\" ", show $ Animate.pKey pos, " [", show $ lTotalKeys loaded - 1, "]"]
+            drawText (ofsX, ofsY + lineSpacing * 6)  $ toText $ concat ["  Time: ", show totalSeconds]
+            drawText (ofsX, ofsY + lineSpacing * 7)  $ toText $ concat ["Pos:"]
+            drawText (ofsX, ofsY + lineSpacing * 8)  $ toText $ concat ["  Frame: ", show $ Animate.pFrameIndex pos,  " [", show $ framesLen - 1, "]"]
+            drawText (ofsX, ofsY + lineSpacing * 9)  $ toText $ concat ["  Time: ", show $ Animate.pCounter pos, " [", show $ frameDelay, "]"]
+            drawText (ofsX, ofsY + lineSpacing * 10) $ toText $ concat ["  Points: (", show x0, ",", show y0, ") (", show x1, ",", show y1, ")"]
+            drawText (ofsX, ofsY + lineSpacing * 11) $ toText $ concat ["  Size: (", show w, ",", show h, ")"]
+            drawText (ofsX, ofsY + lineSpacing * 12) $ toText $ concat $ ["  Offset: "] ++ case Animate.scOffset frameClip of
+              Nothing -> []
+              Just (ox,oy) -> ["(", show ox, ",", show oy, ")"]
+  case originColor of
+    Nothing -> return ()
+    Just originColor' -> drawCrosshair (x,y) originColor'
+  -- HUD
+  when infoShown $ do
+    settings <- asks cSettings
+    drawText (ofsX, ofsY + lineSpacing * 0) ("Mode: " `mappend` if mode == Mode'Playback then "Playback" else "Stepper")
+    drawText (ofsX, ofsY + lineSpacing * 1) ("File: " `mappend` toText (sTarget settings))
+    drawText (ofsX, ofsY + lineSpacing * 2) ("Scale: " `mappend` toText (asScaleString scale))
+    drawText (ofsX, ofsY + lineSpacing * 3) ("Accel: " `mappend` toText (asSpeedString accel))
+  where
+    lineSpacing' x = if x then 26 else 13
+    ofsX = 6
+    ofsY = 6
diff --git a/library/Animate/Preview/State.hs b/library/Animate/Preview/State.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/State.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ConstraintKinds #-}
+module Animate.Preview.State where
+
+import Control.Lens
+import Control.Monad.State (MonadState)
+import Linear
+
+import Animate.Preview.Input
+import Animate.Preview.Color
+import Animate.Preview.Scalar
+import Animate.Preview.Mode
+
+data Vars = Vars
+  { vInput :: Input
+  , vBackground :: Mono
+  , vOriginColor :: Maybe Color
+  , vOutlineColor :: Maybe Color
+  , vOrigin :: V2 Int
+  , vAccel :: Scalar
+  , vScale :: Scalar
+  , vInfoShown :: Bool
+  , vMode :: Mode
+  , vDrawSize :: V2 Int
+  , vWinSize :: V2 Int
+  }
+
+initVars :: V2 Int -> V2 Int -> Vars
+initVars winSize drawSize = Vars
+  { vInput = initInput
+  , vBackground = Mono'Gray
+  , vOriginColor = Just Color'Red
+  , vOutlineColor = Just Color'Green
+  , vOrigin = div <$> drawSize <*> 2
+  , vAccel = Scalar'None
+  , vScale = Scalar'None
+  , vInfoShown = True
+  , vMode = Mode'Playback
+  , vWinSize = winSize
+  , vDrawSize = drawSize
+  }
+
+makeClassy ''Vars
+
+type S m = MonadState Vars m
diff --git a/library/Animate/Preview/Timer.hs b/library/Animate/Preview/Timer.hs
new file mode 100644
--- /dev/null
+++ b/library/Animate/Preview/Timer.hs
@@ -0,0 +1,19 @@
+module Animate.Preview.Timer where
+
+import qualified SDL
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad (when)
+
+import Animate.Preview.Frame
+
+class Monad m => Timer m where
+  startTicks :: m Int
+  default startTicks :: MonadIO m => m Int
+  startTicks = fromIntegral <$> liftIO SDL.ticks
+
+  delayTicks :: Int -> m ()
+  default delayTicks :: MonadIO m => Int -> m ()
+  delayTicks start = liftIO $ do
+    end <- fromIntegral <$> SDL.ticks
+    let ms = (msps - (end -start) * fps) `div` fps
+    when (ms > 0) (SDL.delay $ fromIntegral ms)
diff --git a/package.yaml b/package.yaml
new file mode 100644
--- /dev/null
+++ b/package.yaml
@@ -0,0 +1,65 @@
+name: animate-preview
+version: '0.0.0'
+github: jxv/animate-preview
+license: BSD3
+category: Game
+synopsis: Preview tool for sprite animation
+description: Preview tool for sprite animation
+maintainer: Joe Vargas
+copyright: 2018 Joe Vargas
+data-files:
+- resource/ProggyClean.ttf
+extra-source-files:
+- package.yaml
+- README.md
+- stack.yaml
+ghc-options: -Wall
+default-extensions:
+- DuplicateRecordFields
+- FlexibleContexts
+- FlexibleInstances
+- GeneralizedNewtypeDeriving
+- LambdaCase
+- NamedFieldPuns
+- ScopedTypeVariables
+- OverloadedStrings
+- DefaultSignatures
+- MultiParamTypeClasses
+library:
+  dependencies:
+    - base >=4.7 && <5
+    - aeson
+    - animate
+    - bytestring
+    - containers
+    - filepath
+    - fsnotify
+    - key-state
+    - linear
+    - lens
+    - mtl
+    - optparse-applicative
+    - optparse-generic
+    - random
+    - safe
+    - safe-exceptions
+    - sdl2
+    - sdl2-image
+    - sdl2-ttf
+    - sdl2-gfx
+    - StateVar
+    - text
+    - text-conversions
+    - vector
+  source-dirs: library
+executables:
+  animate-preview:
+    dependencies:
+    - base >=4.7 && <5
+    - animate-preview
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N
+    main: Main.hs
+    source-dirs: executable
diff --git a/resource/ProggyClean.ttf b/resource/ProggyClean.ttf
new file mode 100644
Binary files /dev/null and b/resource/ProggyClean.ttf differ
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,10 @@
+resolver: lts-11.3
+packages:
+- '.'
+extra-deps:
+- 'sdl2-mixer-1.1.0'
+- 'sdl2-ttf-2.0.2'
+- 'animate-0.6.1'
+- 'key-state-0.2.0'
+flags: {}
+extra-package-dbs: []