diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2020 Gergő Érdi (http://gergo.erdi.hu/)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/retroclash-sim.cabal b/retroclash-sim.cabal
new file mode 100644
--- /dev/null
+++ b/retroclash-sim.cabal
@@ -0,0 +1,89 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 4978ab887c6a454f99ca9aaf7e15110a6b7360da275ae11d0437b9b59f1558e0
+
+name:           retroclash-sim
+version:        0.1.0
+synopsis:       High-level simulators from the book "Retrocomputing with Clash"
+description:    A library of functionality useful when simulating retro-computers:
+                .
+                  * Interactive Clash simulation in IO
+                .
+                  * SDL-based framework for graphics simulation
+                .
+                  * VGA signal interpreter
+                .
+category:       Hardware, Graphics
+homepage:       https://unsafePerform.IO/retroclash/
+bug-reports:    https://github.com/gergoerdi/retroclash-sim/issues
+author:         Gergő Érdi
+maintainer:     gergo@erdi.hu
+copyright:      2021 Gergő Érdi
+license:        MIT
+license-file:   LICENSE
+build-type:     Simple
+
+source-repository head
+  type: git
+  location: https://github.com/gergoerdi/retroclash-sim
+
+library
+  exposed-modules:
+      RetroClash.Sim.SDL
+      RetroClash.Sim.VGA
+      RetroClash.Sim.VGASDL
+      RetroClash.Sim.IO
+  other-modules:
+      Paths_retroclash_sim
+  hs-source-dirs:
+      src
+  default-extensions:
+      BinaryLiterals
+      ConstraintKinds
+      DataKinds
+      DeriveAnyClass
+      DeriveGeneric
+      DeriveLift
+      DerivingStrategies
+      ExplicitForAll
+      ExplicitNamespaces
+      FlexibleContexts
+      FlexibleInstances
+      KindSignatures
+      MagicHash
+      MonoLocalBinds
+      NoImplicitPrelude
+      NoMonomorphismRestriction
+      NoStarIsType
+      NoStrictData
+      NoStrict
+      QuasiQuotes
+      ScopedTypeVariables
+      TemplateHaskellQuotes
+      TemplateHaskell
+      TypeApplications
+      TypeFamilies
+      TypeInType
+      TypeOperators
+  ghc-options: -fexpose-all-unfoldings -fno-worker-wrapper -fplugin GHC.TypeLits.KnownNat.Solver -fplugin GHC.TypeLits.Normalise -fplugin GHC.TypeLits.Extra.Solver
+  build-depends:
+      array
+    , arrows
+    , base >=4.14 && <5
+    , clash-ghc >=1.4.2 && <1.5
+    , clash-lib >=1.4.2 && <1.5
+    , clash-prelude >=1.4.2 && <1.5
+    , ghc-typelits-extra
+    , ghc-typelits-knownnat
+    , ghc-typelits-natnormalise
+    , lens
+    , mtl
+    , retroclash-lib ==0.1.*
+    , sdl2
+    , text
+    , transformers
+  default-language: Haskell2010
diff --git a/src/RetroClash/Sim/IO.hs b/src/RetroClash/Sim/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/RetroClash/Sim/IO.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE RankNTypes #-}
+module RetroClash.Sim.IO
+    ( simulateIO
+    , simulateIO_
+    ) where
+
+import Clash.Prelude
+import Control.Concurrent
+import Control.Monad.IO.Class
+import Control.Monad (void)
+import Control.Arrow.Transformer.Automaton
+
+simulateIO
+    :: (KnownDomain dom, MonadIO m, NFDataX i, NFDataX o)
+    => (HiddenClockResetEnable dom => Signal dom i -> Signal dom o)
+    -> i
+    -> IO ((o -> m (i, a)) -> m a)
+simulateIO circuit input0 = do
+    let Automaton step = signalAutomaton circuit
+    ref <- newMVar $ step input0
+    return $ \world -> do
+        (out, Automaton step) <- liftIO $ takeMVar ref
+        (input, result) <- world out
+        liftIO $ putMVar ref $ step input
+        return result
+
+simulateIO_
+    :: (KnownDomain dom, MonadIO m, NFDataX i, NFDataX o)
+    => (HiddenClockResetEnable dom => Signal dom i -> Signal dom o)
+    -> i
+    -> IO ((o -> m i) -> m ())
+simulateIO_ circuit input0 = do
+    sim <- simulateIO circuit input0
+    return $ \world -> do
+        void $ sim $ \output -> do
+            input <- world output
+            return (input, ())
diff --git a/src/RetroClash/Sim/SDL.hs b/src/RetroClash/Sim/SDL.hs
new file mode 100644
--- /dev/null
+++ b/src/RetroClash/Sim/SDL.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections, NumericUnderscores #-}
+module RetroClash.Sim.SDL
+    ( VideoParams(..)
+    , withMainWindow
+    , module SDL.Input.Keyboard.Codes
+
+    , Rasterizer
+    , rasterizePattern
+
+    , BufferArray(..)
+    , newBufferArray
+    , rasterizeBuffer
+
+    , Color
+    , packColor
+    ) where
+
+import Prelude
+import Clash.Prelude hiding (lift)
+import RetroClash.Utils
+
+import SDL hiding (get)
+import SDL.Input.Keyboard.Codes
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Storable
+import Data.Word
+import Control.Concurrent (threadDelay)
+import Data.Text (Text)
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Maybe
+import Data.Array.IO
+import Data.IORef
+import Text.Printf
+
+newtype Rasterizer (w :: Nat) (h :: Nat) = Rasterizer{ runRasterizer :: Ptr () -> Int -> IO () }
+
+data VideoParams = MkVideoParams
+    { windowTitle :: Text
+    , screenScale :: CInt
+    , screenRefreshRate :: Int
+    , reportFPS :: Bool
+    }
+
+withMainWindow
+    :: forall w h m. (KnownNat w, KnownNat h, MonadIO m)
+    => VideoParams
+    -> ([Event] -> (Scancode -> Bool) -> MaybeT m (Rasterizer w h))
+    -> m ()
+withMainWindow MkVideoParams{..} runFrame = do
+    initializeAll
+    window <- createWindow windowTitle defaultWindow
+    windowSize window $= fmap (screenScale *) screenSize
+
+    withTexture <- setupTexture window
+    let render rasterizer = withTexture $ \ptr rowstride ->
+            liftIO $ runRasterizer rasterizer ptr rowstride
+
+    runMaybeT $ atFrameRate reportFPS screenRefreshRate $ do
+        events <- pollEvents
+        keys <- getKeyboardState
+        let windowClosed = any isWindowCloseEvent events
+        guard $ not windowClosed
+        rasterizer <- runFrame events keys
+        render rasterizer
+    destroyWindow window
+  where
+    screenSize = V2 (snatToNum (SNat @w)) (snatToNum (SNat @h))
+
+    setupTexture window = do
+        renderer <- createRenderer window (-1) defaultRenderer
+        texture <- createTexture renderer RGB888 TextureAccessStreaming screenSize
+
+        return $ \drawToTexture -> do
+            (ptr, stride) <- lockTexture texture Nothing
+            drawToTexture ptr (fromIntegral stride)
+            unlockTexture texture
+            SDL.copy renderer texture Nothing Nothing
+            present renderer
+
+    isWindowCloseEvent ev = case eventPayload ev of
+        WindowClosedEvent{} -> True
+        _ -> False
+
+atFrameRate :: (MonadIO m) => Bool -> Int -> m a -> m b
+atFrameRate reportFPS frameRate act = do
+    before0 <- ticks
+    go before0 1
+  where
+    go before0 i = do
+        before <- ticks
+        act
+        after <- ticks
+        waitFrame frameRate before after
+        if i < frameRate then go before0 (i + 1) else do
+            when reportFPS $ do
+                let elapsed = after - before0
+                liftIO $ printf "%d frames at %d ms, %.2f fps\n" frameRate elapsed (fps elapsed)
+            before0 <- ticks
+            go before0 1
+
+    fps elapsed = (fromIntegral frameRate * 1000) / fromIntegral elapsed :: Double
+
+waitFrame :: (MonadIO m) => Int -> Word32 -> Word32 -> m ()
+waitFrame frameRate before after = when (slack > 0) $ liftIO $ threadDelay slack
+  where
+    frameTime = 1_000_000 `div` frameRate
+    elapsed = fromIntegral $ 1000 * (after - before)
+    slack = frameTime - elapsed
+
+type Color = (Word8, Word8, Word8)
+
+{-# INLINE packColor #-}
+packColor :: Color -> Word32
+packColor (r, g, b) =
+    fromIntegral r `shiftL` 16 .|.
+    fromIntegral g `shiftL` 8 .|.
+    fromIntegral b `shiftL` 0
+
+rasterizePattern :: (KnownNat w, KnownNat h) => (Index w -> Index h -> Color) -> Rasterizer w h
+rasterizePattern draw = Rasterizer $ \ptr rowstride -> do
+    forM_ [minBound..maxBound] $ \y -> do
+        let rowPtr = plusPtr ptr $ fromIntegral y * rowstride
+        forM_ [minBound .. maxBound] $ \x -> do
+            pokeElemOff rowPtr (fromIntegral x) (packColor $ draw x y)
+
+newtype BufferArray (w :: Nat) (h :: Nat) = BufferArray{ getArray :: IOUArray (Index w, Index h) Word32 }
+
+newBufferArray :: forall w h. (KnownNat w, KnownNat h) => IO (BufferArray w h)
+newBufferArray = BufferArray <$> newArray ((minBound, minBound), (maxBound, maxBound)) 0
+
+rasterizeBuffer :: forall w h. (KnownNat w, KnownNat h) => BufferArray w h -> Rasterizer w h
+rasterizeBuffer (BufferArray arr) = Rasterizer $ \ptr rowstride -> do
+    forM_ [minBound..maxBound] $ \y -> do
+        let rowPtr = plusPtr ptr $ fromIntegral y * rowstride
+        forM_ [minBound..maxBound] $ \x -> do
+            pokeElemOff rowPtr (fromIntegral x) =<< readArray arr (x, y)
diff --git a/src/RetroClash/Sim/VGA.hs b/src/RetroClash/Sim/VGA.hs
new file mode 100644
--- /dev/null
+++ b/src/RetroClash/Sim/VGA.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE NumericUnderscores, RecordWildCards #-}
+{-# LANGUAGE RankNTypes #-}
+module RetroClash.Sim.VGA
+    ( vgaSink
+    , initSink
+    , SinkState
+    ) where
+
+import RetroClash.Utils
+import RetroClash.VGA
+
+import Control.Monad.State
+import Data.Foldable (for_)
+import Control.Lens hiding (Index)
+import Clash.Prelude hiding (lift)
+import Data.Proxy
+
+import Debug.Trace
+
+vgaRetrace :: VGATiming visible -> (Int, Bit)
+vgaRetrace VGATiming{..} = (snatToNum pulseWidth + snatToNum postWidth - 1, toActiveDyn polarity True)
+
+data SinkState n
+    = Visible (Index n)
+    | WaitSync Bool
+    | Retrace Int
+    deriving (Show)
+
+{-# INLINE vgaSink #-}
+vgaSink
+    :: forall w h rgb m ps. (KnownNat w, KnownNat h, MonadState (SinkState w, SinkState h) m)
+    => VGATimings ps w h
+    -> (Index w -> Index h -> rgb -> m ())
+    -> (Bit, Bit, rgb)
+    -> m Bool
+vgaSink VGATimings{..} paint (hsync0, vsync0, color) = do
+    (x, endLine) <- stateZoom _1 $ direction w horizRetrace hsync
+    (y, endFrame) <- stateZoomIf endLine _2 $ direction h vertRetrace vsync
+    for_ (liftA2 (,) x y) $ \(x, y) -> paint x y color
+    return $ endLine && endFrame
+  where
+    (horizRetrace, hsyncTarget) = vgaRetrace vgaHorizTiming
+    (vertRetrace, vsyncTarget) = vgaRetrace vgaVertTiming
+
+    vsync = vsync0 == vsyncTarget
+    hsync = hsync0 == hsyncTarget
+
+    w = snatToNum (SNat @w)
+    h = snatToNum (SNat @h)
+
+    direction vis retrace sync s = case s of
+        Retrace n -> ((Nothing, False), s')
+          where
+            n' = n + 1
+            s' = if n' == retrace then Visible 0 else Retrace n'
+        Visible i -> ((Just i, False), s')
+          where
+            s' = maybe (WaitSync sync) Visible $ succIdx i
+        WaitSync prevSync -> ((Nothing, end), s')
+          where
+            end = not prevSync && sync
+            s' = if end then Retrace 0 else WaitSync sync
+
+initSink :: (SinkState w, SinkState h)
+initSink = (WaitSync False, WaitSync False)
+
+{-# INLINE stateZoom #-}
+stateZoom :: (MonadState s0 m) => Lens' s0 s -> (s -> (a, s)) -> m a
+stateZoom = stateZoomIf True
+
+{-# INLINE stateZoomIf #-}
+stateZoomIf :: (MonadState s0 m) => Bool -> Lens' s0 s -> (s -> (a, s)) -> m a
+stateZoomIf update l f = state $ \s0 ->
+  let s = view l s0
+      (x, s') = f s
+      s0' = s0 & l .~ s'
+  in (x, if update then s0' else s0)
diff --git a/src/RetroClash/Sim/VGASDL.hs b/src/RetroClash/Sim/VGASDL.hs
new file mode 100644
--- /dev/null
+++ b/src/RetroClash/Sim/VGASDL.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE NumericUnderscores, RecordWildCards #-}
+module RetroClash.Sim.VGASDL
+    ( vgaSinkBuf
+    ) where
+
+import Clash.Prelude
+import RetroClash.Utils
+import RetroClash.VGA
+import RetroClash.Sim.VGA
+import RetroClash.Sim.SDL
+
+import Control.Monad.State
+import Data.Word
+import Data.Array.IO
+
+{-# INLINE vgaSinkBuf #-}
+vgaSinkBuf
+    :: (KnownNat w, KnownNat h, MonadIO m, MonadState (SinkState w, SinkState h) m)
+    => VGATimings ps w h
+    -> BufferArray w h
+    -> (Bit, Bit, Color)
+    -> m Bool
+vgaSinkBuf vgaMode (BufferArray arr) = vgaSink vgaMode writeBuf
+  where
+    writeBuf x y rgb = liftIO $ writeArray arr (x, y) $ packColor rgb