diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for typograffiti
+
+## Unreleased changes
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,6 @@
+# typograffiti
+Typograffiti aims to make working with text in multimedia applications easy.
+
+## requirements
+* opengl 3.x
+* freetype 2.x
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/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+
+import           Control.Monad          (unless)
+import           Control.Monad.Except   (runExceptT, MonadError)
+import           Control.Monad.IO.Class (MonadIO (..))
+import           Data.Function          (fix)
+import           Graphics.GL
+import           SDL                    hiding (rotate)
+import           System.FilePath        ((</>))
+
+import           Typograffiti
+
+
+myTextStuff
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     )
+  => Window -> m ()
+myTextStuff w = do
+  let ttfName = "assets" </> "Lora-Regular.ttf"
+  store <- newDefaultFontStore (get $ windowSize w)
+  RenderedText draw size <-
+    getTextRendering
+      store
+      ttfName
+      (GlyphSizeInPixels 16 16)
+      $ unlines
+          [ "Hey there!"
+          , "This is a test of the emergency word system."
+          , "Quit at any time."
+          ]
+  liftIO $ print ("text size", size)
+
+  fix $ \loop -> do
+    events <- fmap eventPayload
+      <$> pollEvents
+
+    glClearColor 0 0 0 1
+    glClear GL_COLOR_BUFFER_BIT
+
+    (V2 dw dh) <- glGetDrawableSize w
+    glViewport 0 0 (fromIntegral dw) (fromIntegral dh)
+
+    draw [move 20 32, rotate (pi / 4), color 1 0 1 1, alpha 0.5]
+
+    glSwapWindow w
+    unless (QuitEvent `elem` events) loop
+
+
+main :: IO ()
+main = do
+  SDL.initializeAll
+
+  let openGL = defaultOpenGL
+        { glProfile = Core Debug 3 3 }
+      wcfg = defaultWindow
+        { windowInitialSize = V2 640 480
+        , windowOpenGL      = Just openGL
+        , windowResizable   = True
+        }
+
+  w <- createWindow "Typograffiti" wcfg
+  _ <- glCreateContext w
+
+  runExceptT (myTextStuff w)
+    >>= either (fail . show) return
diff --git a/src/Typograffiti.hs b/src/Typograffiti.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti.hs
@@ -0,0 +1,47 @@
+-- |
+-- Module:     Typograffiti
+-- Copyright:  (c) 2018 Schell Scivally
+-- License:    MIT
+-- Maintainer: Schell Scivally <schell@takt.com>
+--
+-- This module provides easy freetype2-based font rendering with a nice
+-- Haskell interface.
+module Typograffiti
+  (
+  -- * Some simple default text rendering operations
+    RenderedText (..)
+  , TextRenderingData (..)
+  , FontStore
+  , newDefaultFontStore
+  , getTextRendering
+  -- * Transforming rendered text
+  , TextTransform (..)
+  -- TODO Vector variants of the transformation helpers.
+  -- i.e. moveV2, scaleV2, colorV4
+  , move
+  , scale
+  , rotate
+  , color
+  , alpha
+  , Layout (..)
+  -- * Getting low
+  , allocAtlas
+  , loadText
+  , unloadMissingWords
+  , stringTris
+  , makeDefaultAllocateWord
+  , asciiChars
+  -- * Types
+  , GlyphSize (..)
+  , CharSize (..)
+  , Atlas (..)
+  , WordCache (..)
+  , AllocatedRendering (..)
+  -- * Errors
+  , TypograffitiError (..)
+  ) where
+
+import           Typograffiti.Atlas
+import           Typograffiti.Cache
+import           Typograffiti.Glyph
+import           Typograffiti.Store
diff --git a/src/Typograffiti/Atlas.hs b/src/Typograffiti/Atlas.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/Atlas.hs
@@ -0,0 +1,297 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE TypeApplications #-}
+-- |
+-- Module:     Typograffiti.Atlas
+-- Copyright:  (c) 2018 Schell Scivally
+-- License:    MIT
+-- Maintainer: Schell Scivally <schell@takt.com>
+--
+-- This module provides a font-character atlas to use in font rendering with
+-- opengl.
+--
+module Typograffiti.Atlas where
+
+import           Control.Monad
+import           Control.Monad.Except                              (MonadError (..))
+import           Control.Monad.IO.Class
+import           Data.IntMap                                       (IntMap)
+import qualified Data.IntMap                                       as IM
+import           Data.Vector.Unboxed                               (Vector)
+import qualified Data.Vector.Unboxed                               as UV
+import           Foreign.Marshal.Utils                             (with)
+import           Graphics.GL.Core32
+import           Graphics.GL.Types
+import           Graphics.Rendering.FreeType.Internal.Bitmap       as BM
+import           Graphics.Rendering.FreeType.Internal.GlyphMetrics as GM
+import           Linear
+
+import           Typograffiti.GL
+import           Typograffiti.Glyph
+import           Typograffiti.Utils
+
+
+
+data TypograffitiError =
+    TypograffitiErrorNoGlyphMetricsForChar Char
+  -- ^ The are no glyph metrics for this character. This probably means
+  -- the character has not been loaded into the atlas.
+  | TypograffitiErrorFreetype String String
+  -- ^ There was a problem while interacting with the freetype2 library.
+  | TypograffitiErrorGL String
+  -- ^ There was a problem while interacting with OpenGL.
+  deriving (Show, Eq)
+
+
+--------------------------------------------------------------------------------
+-- Atlas
+--------------------------------------------------------------------------------
+
+
+data Atlas = Atlas { atlasTexture     :: GLuint
+                   , atlasTextureSize :: V2 Int
+                   , atlasLibrary     :: FT_Library
+                   , atlasFontFace    :: FT_Face
+                   , atlasMetrics     :: IntMap GlyphMetrics
+                   , atlasGlyphSize   :: GlyphSize
+                   , atlasFilePath    :: FilePath
+                   }
+
+
+emptyAtlas :: FT_Library -> FT_Face -> GLuint -> Atlas
+emptyAtlas lib fce t = Atlas t 0 lib fce mempty (GlyphSizeInPixels 0 0) ""
+
+
+data AtlasMeasure = AM { amWH      :: V2 Int
+                       , amXY      :: V2 Int
+                       , rowHeight :: Int
+                       } deriving (Show, Eq)
+
+
+emptyAM :: AtlasMeasure
+emptyAM = AM 0 (V2 1 1) 0
+
+
+-- | The amount of spacing between glyphs rendered into the atlas's texture.
+spacing :: Int
+spacing = 1
+
+
+-- | Extract the measurements of a character in the FT_Face and append it to
+-- the given AtlasMeasure.
+measure
+  :: FT_Face
+  -> Int
+  -> (IntMap AtlasMeasure, AtlasMeasure)
+  -> Char
+  -> FreeTypeIO (IntMap AtlasMeasure, AtlasMeasure)
+measure fce maxw (prev, am@AM{..}) char
+  -- Skip chars that have already been measured
+  | fromEnum char `IM.member` prev = return (prev, am)
+  | otherwise = do
+    let V2 x y = amXY
+        V2 w h = amWH
+    -- Load the char, replacing the glyph according to
+    -- https://www.freetype.org/freetype2/docs/tutorial/step1.html
+    loadChar fce (fromIntegral $ fromEnum char) ft_LOAD_RENDER
+    -- Get the glyph slot
+    slot <- liftIO $ peek $ glyph fce
+    -- Get the bitmap
+    bmp <- liftIO $ peek $ bitmap slot
+    let bw = fromIntegral $ BM.width bmp
+        bh = fromIntegral $ rows bmp
+        gotoNextRow = (x + bw + spacing) >= maxw
+        rh = if gotoNextRow then 0 else max bh rowHeight
+        nx = if gotoNextRow then 0 else x + bw + spacing
+        nw = max w (x + bw + spacing)
+        nh = max h (y + rh + spacing)
+        ny = if gotoNextRow then nh else y
+        am1 = AM { amWH = V2 nw nh
+                 , amXY = V2 nx ny
+                 , rowHeight = rh
+                 }
+    return (IM.insert (fromEnum char) am prev, am1)
+
+
+texturize :: IntMap (V2 Int) -> Atlas -> Char -> FreeTypeIO Atlas
+texturize xymap atlas@Atlas{..} char
+  | Just pos@(V2 x y) <- IM.lookup (fromEnum char) xymap = do
+    -- Load the char
+    loadChar atlasFontFace (fromIntegral $ fromEnum char) ft_LOAD_RENDER
+    -- Get the slot and bitmap
+    slot  <- liftIO $ peek $ glyph atlasFontFace
+    bmp   <- liftIO $ peek $ bitmap slot
+    -- Update our texture by adding the bitmap
+    glTexSubImage2D
+      GL_TEXTURE_2D
+      0
+      (fromIntegral x)
+      (fromIntegral y)
+      (fromIntegral $ BM.width bmp)
+      (fromIntegral $ rows bmp)
+      GL_RED
+      GL_UNSIGNED_BYTE
+      (castPtr $ buffer bmp)
+    -- Get the glyph metrics
+    ftms  <- liftIO $ peek $ metrics slot
+    -- Add the metrics to the atlas
+    let vecwh = fromIntegral <$> V2 (BM.width bmp) (rows bmp)
+        canon = floor @Double @Int . (* 0.015625) . fromIntegral
+        vecsz = canon <$> V2 (GM.width ftms) (GM.height ftms)
+        vecxb = canon <$> V2 (horiBearingX ftms) (horiBearingY ftms)
+        vecyb = canon <$> V2 (vertBearingX ftms) (vertBearingY ftms)
+        vecad = canon <$> V2 (horiAdvance ftms) (vertAdvance ftms)
+        mtrcs = GlyphMetrics { glyphTexBB = (pos, pos + vecwh)
+                             , glyphTexSize = vecwh
+                             , glyphSize = vecsz
+                             , glyphHoriBearing = vecxb
+                             , glyphVertBearing = vecyb
+                             , glyphAdvance = vecad
+                             }
+    return atlas{ atlasMetrics = IM.insert (fromEnum char) mtrcs atlasMetrics }
+
+  | otherwise = do
+    liftIO $ putStrLn "could not find xy"
+    return atlas
+
+-- | Allocate a new 'Atlas'.
+-- When creating a new 'Atlas' you must pass all the characters that you
+-- might need during the life of the 'Atlas'. Character texturization only
+-- happens once.
+allocAtlas
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     )
+  => FilePath
+  -- ^ Path to the font file to use for this Atlas.
+  -> GlyphSize
+  -- ^ Size of glyphs in this Atlas.
+  -> String
+  -- ^ The characters to include in this 'Atlas'.
+  -> m Atlas
+allocAtlas fontFilePath gs str = do
+  e <- liftIO $ runFreeType $ do
+    fce <- newFace fontFilePath
+    case gs of
+      GlyphSizeInPixels w h -> setPixelSizes fce w h
+      GlyphSizeByChar (CharSize w h dpix dpiy) -> setCharSize fce w h dpix dpiy
+
+    (amMap, am) <- foldM (measure fce 512) (mempty, emptyAM) str
+
+    let V2 w h = amWH am
+        xymap :: IntMap (V2 Int)
+        xymap  = amXY <$> amMap
+
+    t <- liftIO $ do
+      t <- allocAndActivateTex GL_TEXTURE0
+      glPixelStorei GL_UNPACK_ALIGNMENT 1
+      withCString (replicate (w * h) $ toEnum 0) $
+        glTexImage2D GL_TEXTURE_2D 0 GL_RED (fromIntegral w) (fromIntegral h)
+                     0 GL_RED GL_UNSIGNED_BYTE . castPtr
+      return t
+
+    lib   <- getLibrary
+    atlas <- foldM (texturize xymap) (emptyAtlas lib fce t) str
+
+    glGenerateMipmap GL_TEXTURE_2D
+    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT
+    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT
+    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR
+    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR
+    glBindTexture GL_TEXTURE_2D 0
+    glPixelStorei GL_UNPACK_ALIGNMENT 4
+    return
+      atlas{ atlasTextureSize = V2 w h
+           , atlasGlyphSize = gs
+           , atlasFilePath = fontFilePath
+           }
+
+  either
+    (throwError . TypograffitiErrorFreetype "cannot alloc atlas")
+    (return . fst)
+    e
+
+
+-- | Releases all resources associated with the given 'Atlas'.
+freeAtlas :: MonadIO m => Atlas -> m ()
+freeAtlas a = liftIO $ do
+  _ <- ft_Done_FreeType (atlasLibrary a)
+  -- _ <- unloadMissingWords a ""
+  with (atlasTexture a) $ \ptr -> glDeleteTextures 1 ptr
+
+
+-- | Construct the geometry needed to render the given character.
+makeCharQuad
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     )
+  => Atlas
+  -- ^ The atlas that contains the metrics for the given character.
+  -> Bool
+  -- ^ Whether or not to use kerning.
+  -> Int
+  -- ^ The current "pen position".
+  -> Maybe FT_UInt
+  -- ^ The freetype index of the previous character, if available.
+  -> Char
+  -- ^ The character to generate geometry for.
+  -> m (Vector (V2 Float, V2 Float), Int, Maybe FT_UInt)
+  -- ^ Returns the generated geometry (position in 2-space and UV parameters),
+  -- the next pen position and the freetype index of the given character, if
+  -- available.
+makeCharQuad Atlas{..} useKerning penx mLast char = do
+  let ichar = fromEnum char
+  eNdx <- withFreeType (Just atlasLibrary) $ getCharIndex atlasFontFace ichar
+  let mndx = either (const Nothing) Just eNdx
+  px <- case (,,) <$> mndx <*> mLast <*> Just useKerning of
+    Just (ndx,lndx,True) -> do
+      e <- withFreeType (Just atlasLibrary) $
+        getKerning atlasFontFace lndx ndx ft_KERNING_DEFAULT
+      return $ either (const penx) ((+penx) . floor . (* 0.015625) . fromIntegral . fst) e
+    _  -> return $ fromIntegral penx
+  case IM.lookup ichar atlasMetrics of
+    Nothing -> throwError $ TypograffitiErrorNoGlyphMetricsForChar char
+    Just GlyphMetrics{..} -> do
+      let V2 dx dy = fromIntegral <$> glyphHoriBearing
+          x = fromIntegral px + dx
+          y = -dy
+          V2 w h = fromIntegral <$> glyphSize
+          V2 aszW aszH = fromIntegral <$> atlasTextureSize
+          V2 texL texT = fromIntegral <$> fst glyphTexBB
+          V2 texR texB = fromIntegral <$> snd glyphTexBB
+
+          tl = (V2 x      y   , V2 (texL/aszW) (texT/aszH))
+          tr = (V2 (x+w)  y   , V2 (texR/aszW) (texT/aszH))
+          br = (V2 (x+w) (y+h), V2 (texR/aszW) (texB/aszH))
+          bl = (V2 x     (y+h), V2 (texL/aszW) (texB/aszH))
+      let vs = UV.fromList [ tl, tr, br
+                           , tl, br, bl
+                           ]
+      let V2 ax _ = glyphAdvance
+      return (vs, px + ax, mndx)
+
+
+-- | A string containing all standard ASCII characters.
+-- This is often passed as the 'String' parameter in 'allocAtlas'.
+asciiChars :: String
+asciiChars = map toEnum [32..126]
+
+
+-- | Generate the geometry of the given string.
+stringTris
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     )
+  => Atlas
+  -- ^ The font atlas.
+  -> Bool
+  -- ^ Whether or not to use kerning.
+  -> String
+  -- ^ The string.
+  -> m (Vector (V2 Float, V2 Float))
+stringTris atlas useKerning str = do
+  (vs, _, _) <- foldM gen (mempty, 0, Nothing) str
+  return $ UV.concat vs
+  where gen (vs, penx, mndx) c = do
+          (newVs, newPenx, newMndx) <- makeCharQuad atlas useKerning penx mndx c
+          return (vs ++ [newVs], newPenx, newMndx)
diff --git a/src/Typograffiti/Cache.hs b/src/Typograffiti/Cache.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/Cache.hs
@@ -0,0 +1,350 @@
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+-- |
+-- Module:     Typograffiti.Cache
+-- Copyright:  (c) 2018 Schell Scivally
+-- License:    MIT
+-- Maintainer: Schell Scivally <schell@takt.com>
+--
+-- This module provides a method of caching rendererd text, making it suitable
+-- for interactive rendering. You can use the defaultCache or provide your own.
+--
+module Typograffiti.Cache where
+
+import           Control.Monad          (foldM)
+import           Control.Monad.Except   (MonadError (..), liftEither,
+                                         runExceptT)
+import           Control.Monad.IO.Class (MonadIO (..))
+import           Data.Bifunctor         (first)
+import           Data.ByteString        (ByteString)
+import qualified Data.ByteString.Char8  as B8
+import qualified Data.IntMap            as IM
+import           Data.Map               (Map)
+import qualified Data.Map               as M
+import           Data.Maybe             (fromMaybe)
+import qualified Data.Vector.Unboxed    as UV
+import           Foreign.Marshal.Array
+import           Graphics.GL
+import           Linear
+
+import           Typograffiti.Atlas
+import           Typograffiti.GL
+import           Typograffiti.Glyph
+
+
+-- | Generic operations for text layout.
+class Layout t where
+  translate :: t -> V2 Float -> t
+
+
+-- | Holds an allocated draw function for some amount of text. The function
+-- takes one parameter that can be used to transform the text in various ways.
+-- This type is generic and can be used to take advantage of your own font
+-- rendering shaders.
+data AllocatedRendering t = AllocatedRendering
+  { arDraw    :: t -> IO ()
+    -- ^ Draw the text with some transformation in some monad.
+  , arRelease :: IO ()
+    -- ^ Release the allocated draw function in some monad.
+  , arSize    :: V2 Int
+    -- ^ The size (in pixels) of the drawn text.
+  }
+
+
+newtype WordCache t = WordCache
+  { unWordCache :: Map String (AllocatedRendering t) }
+  deriving (Semigroup, Monoid)
+
+
+-- | Load a string of words into the WordCache.
+loadWords
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     )
+  => (Atlas -> String -> m (AllocatedRendering t))
+  -- ^ Operation used to allocate a word.
+  -> Atlas
+  -- ^ The character atlas that holds our letters, which is used to generate
+  -- the word geometry.
+  -> WordCache t
+  -- ^ The atlas to load the words into.
+  -> String
+  -- ^ The string of words to load, with each word separated by spaces.
+  -> m (WordCache t)
+loadWords f atlas (WordCache cache) str =
+  WordCache
+    <$> foldM loadWord cache (words str)
+  where loadWord wm word
+          | M.member word wm = return wm
+          | otherwise =
+              flip (M.insert word) wm <$> f atlas word
+
+
+-- | Unload any words from the cache that are not contained in the source string.
+unloadMissingWords
+  :: MonadIO m
+  => WordCache t
+  -- ^ The WordCache to unload words from.
+  -> String
+  -- ^ The source string.
+  -> m (WordCache t)
+unloadMissingWords (WordCache cache) str = do
+  let ws      = M.fromList $ zip (words str) (repeat ())
+      missing = M.difference cache ws
+      retain  = M.difference cache missing
+  liftIO
+    $ sequence_
+    $ arRelease <$> missing
+  return $ WordCache retain
+
+
+-- | Constructs a 'Renderer2' from the given color and string. The 'WordMap'
+-- record of the given 'Atlas' is used to construct the string geometry, greatly
+-- improving performance and allowing longer strings to be compiled and renderered
+-- in real time. To create a new 'Atlas' see 'allocAtlas'.
+--
+-- Note that since word geometries are stored in the 'Atlas' 'WordMap' and multiple
+-- renderers can reference the same 'Atlas', the returned 'Renderer2' contains a
+-- clean up operation that does nothing. It is expected that the programmer
+-- will call 'freeAtlas' manually when the 'Atlas' is no longer needed.
+loadText
+  :: forall m t.
+     ( MonadIO m
+     , MonadError TypograffitiError m
+     , Layout t
+     )
+  => (Atlas -> String -> m (AllocatedRendering t))
+  -- ^ Operation used to allocate a word.
+  -> Atlas
+  -- ^ The character atlas that holds our letters.
+  -> WordCache t
+  -- ^ The WordCache to load AllocatedRenderings into.
+  -> String
+  -- ^ The string to render.
+  -- This string may contain newlines, which will be respected.
+  -> m (t -> IO (), V2 Int, WordCache t)
+  -- ^ Returns a function for rendering the text, the size of the text and the
+  -- new WordCache with the allocated renderings of the text.
+loadText f atlas wc str = do
+  wc1@(WordCache cache) <- loadWords f atlas wc str
+  let glyphw  = round $ pixelWidth $ atlasGlyphSize atlas
+      spacew  :: Int
+      spacew  = fromMaybe glyphw $ do
+        metrcs <- IM.lookup (fromEnum ' ') $ atlasMetrics atlas
+        let V2 x _ = glyphAdvance metrcs
+        return x
+      glyphh = pixelHeight $ atlasGlyphSize atlas
+      spaceh = round glyphh
+      isWhiteSpace c = c == ' ' || c == '\n' || c == '\t'
+      renderWord :: t -> V2 Int -> String -> IO ()
+      renderWord _ _ ""       = return ()
+      renderWord t (V2 _ y) ('\n':cs) = renderWord t (V2 0 (y + spaceh)) cs
+      renderWord t (V2 x y) (' ':cs)  = renderWord t (V2 (x + spacew) y) cs
+      renderWord t v@(V2 x y) cs               = do
+        let word = takeWhile (not . isWhiteSpace) cs
+            rest = drop (length word) cs
+        case M.lookup word cache of
+          Nothing -> renderWord t v rest
+          Just ar -> do
+            let t1 = translate t $ fromIntegral <$> v
+                V2 w _ = arSize ar
+                pen = V2 (x + fromIntegral w) y
+            arDraw ar t1
+            renderWord t pen rest
+      rr t = renderWord t 0 str
+      measureString :: (V2 Int, V2 Int) -> String -> (V2 Int, V2 Int)
+      measureString xywh ""                    = xywh
+      measureString (V2 x y, V2 w _) (' ':cs)  =
+        let nx = x + spacew in measureString (V2 nx y, V2 (max w nx) y) cs
+      measureString (V2 x y, V2 w h) ('\n':cs) =
+        let ny = y + spaceh in measureString (V2 x ny, V2 w (max h ny)) cs
+      measureString (V2 x y, V2 w h) cs        =
+        let word = takeWhile (not . isWhiteSpace) cs
+            rest = drop (length word) cs
+            n    = case M.lookup word cache of
+                    Nothing -> (V2 x y, V2 w h)
+                    Just ar -> let V2 ww _ = arSize ar
+                                   nx      = x + ww
+                                in (V2 nx y, V2 (max w nx) y)
+        in measureString n rest
+      V2 szw szh = snd $ measureString (0,0) str
+  return (rr, V2 szw (max spaceh szh), wc1)
+
+
+--------------------------------------------------------------------------------
+-- Default word allocation
+--------------------------------------------------------------------------------
+
+
+data SpatialTransform = SpatialTransformTranslate (V2 Float)
+                      | SpatialTransformScale (V2 Float)
+                      | SpatialTransformRotate Float
+
+
+data TextTransform = TextTransformMultiply (V4 Float)
+                   | TextTransformSpatial SpatialTransform
+
+
+move :: Float -> Float -> TextTransform
+move x y =
+  TextTransformSpatial
+  $ SpatialTransformTranslate
+  $ V2 x y
+
+
+scale :: Float -> Float -> TextTransform
+scale x y =
+  TextTransformSpatial
+  $ SpatialTransformScale
+  $ V2 x y
+
+
+rotate :: Float -> TextTransform
+rotate =
+  TextTransformSpatial
+  . SpatialTransformRotate
+
+
+color :: Float -> Float -> Float -> Float -> TextTransform
+color r g b a =
+  TextTransformMultiply
+  $ V4 r g b a
+
+
+alpha :: Float -> TextTransform
+alpha =
+  TextTransformMultiply
+  . V4 1 1 1
+
+
+instance Layout [TextTransform] where
+  translate ts (V2 x y) = ts ++ [move x y]
+
+
+transformToUniforms
+  :: [TextTransform]
+  -> (M44 Float, V4 Float)
+transformToUniforms = foldl toUniform (identity, 1.0)
+  where toUniform (mv, clr) (TextTransformMultiply c) =
+          (mv, clr * c)
+        toUniform (mv, clr) (TextTransformSpatial s) =
+          let mv1 = case s of
+                SpatialTransformTranslate (V2 x y) ->
+                  mv !*! mat4Translate (V3 x y 0)
+                SpatialTransformScale (V2 x y) ->
+                  mv !*! mat4Scale (V3 x y 1)
+                SpatialTransformRotate r ->
+                  mv !*! mat4Rotate r (V3 0 0 1)
+          in (mv1, clr)
+
+
+vertexShader :: ByteString
+vertexShader = B8.pack $ unlines
+  [ "#version 330 core"
+  , "uniform mat4 projection;"
+  , "uniform mat4 modelview;"
+  , "in vec2 position;"
+  , "in vec2 uv;"
+  , "out vec2 fuv;"
+  , "void main () {"
+  , "  fuv = uv;"
+  , "  gl_Position = projection * modelview * vec4(position.xy, 0.0, 1.0);"
+  , "}"
+  ]
+
+
+fragmentShader :: ByteString
+fragmentShader = B8.pack $ unlines
+  [ "#version 330 core"
+  , "in vec2 fuv;"
+  , "out vec4 fcolor;"
+  , "uniform sampler2D tex;"
+  , "uniform vec4 mult_color;"
+  , "void main () {"
+  , "  vec4 tcolor = texture(tex, fuv);"
+  , "  fcolor = vec4(mult_color.rgb, mult_color.a * tcolor.r);"
+  , "}"
+  ]
+
+
+makeDefaultAllocateWord
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     , Integral i
+     )
+  => IO (V2 i)
+  -- ^ A monadic operation that returns the current context's dimentions.
+  -- This is used to set the orthographic projection for rendering text.
+  -> m (Atlas
+        -> String
+        -> IO (Either TypograffitiError (AllocatedRendering [TextTransform]))
+       )
+makeDefaultAllocateWord getContextSize = do
+  let position = 0
+      uv       = 1
+      liftGL   = liftEither . first TypograffitiErrorGL
+  vert <- liftGL =<< compileOGLShader vertexShader GL_VERTEX_SHADER
+  frag <- liftGL =<< compileOGLShader fragmentShader GL_FRAGMENT_SHADER
+  prog <- liftGL =<< compileOGLProgram
+    [ ("position", fromIntegral position)
+    , ("uv", fromIntegral uv)
+    ]
+    [vert, frag]
+  glUseProgram prog
+  glEnable GL_BLEND
+  glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
+  -- Get our uniform locations
+  pjU    <- getUniformLocation prog "projection"
+  mvU    <- getUniformLocation prog "modelview"
+  multU  <- getUniformLocation prog "mult_color"
+  texU   <- getUniformLocation prog "tex"
+  -- Return a function that will generate new words
+  return $ \atlas string -> do
+    vao   <- newBoundVAO
+    pbuf  <- newBuffer
+    uvbuf <- newBuffer
+    -- Generate our string geometry
+    runExceptT (stringTris atlas True string) >>= \case
+      Left err -> return $ Left err
+      Right geom -> do
+        let (ps, uvs) = UV.unzip geom
+        -- Buffer the geometry into our attributes
+        bufferGeometry position pbuf  ps
+        bufferGeometry uv       uvbuf uvs
+        glBindVertexArray 0
+
+        let draw :: [TextTransform] -> IO ()
+            draw ts = do
+              let (mv, multVal) = transformToUniforms ts
+              glUseProgram prog
+              wsz <- getContextSize
+              let pj :: M44 Float = orthoProjection wsz
+              updateUniform prog pjU pj
+              updateUniform prog mvU  mv
+              updateUniform prog multU multVal
+              updateUniform prog texU (0 :: Int)
+              glBindVertexArray vao
+              withBoundTextures [atlasTexture atlas] $ do
+                drawVAO
+                  prog
+                  vao
+                  GL_TRIANGLES
+                  (fromIntegral $ UV.length ps)
+                glBindVertexArray 0
+
+            release = do
+              withArray [pbuf, uvbuf] $ glDeleteBuffers 2
+              withArray [vao] $ glDeleteVertexArrays 1
+            (tl, br) = boundingBox ps
+
+            size = br - tl
+        return
+          $ Right AllocatedRendering
+              { arDraw    = draw
+              , arRelease = release
+              , arSize    = round <$> size
+              }
diff --git a/src/Typograffiti/GL.hs b/src/Typograffiti/GL.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/GL.hs
@@ -0,0 +1,367 @@
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase        #-}
+module Typograffiti.GL where
+
+import           Control.Exception      (assert)
+import           Control.Monad          (forM_, when, replicateM)
+import           Control.Monad.IO.Class (MonadIO (..))
+import           Data.ByteString        (ByteString)
+import qualified Data.ByteString.Char8  as B8
+import qualified Data.Foldable          as F
+import qualified Data.Vector.Storable   as SV
+import           Data.Vector.Unboxed    (Unbox)
+import qualified Data.Vector.Unboxed    as UV
+import           Foreign.C.String       (peekCAStringLen, withCString)
+import           Foreign.Marshal.Array
+import           Foreign.Marshal.Utils
+import           Foreign.Ptr
+import           Foreign.Storable
+import           GHC.TypeLits           (KnownNat)
+import           Graphics.GL.Core32
+import           Graphics.GL.Types
+import           Linear
+import           Linear.V               (Finite, Size, dim, toV)
+
+
+allocAndActivateTex :: MonadIO m => GLenum -> m GLuint
+allocAndActivateTex u = do
+  [t] <- liftIO $ allocaArray 1 $ \ptr -> do
+    glGenTextures 1 ptr
+    peekArray 1 ptr
+  glActiveTexture u
+  glBindTexture GL_TEXTURE_2D t
+  return t
+
+
+clearErrors :: MonadIO m => String -> m ()
+clearErrors str = do
+  err' <- glGetError
+  when (err' /= 0) $ do
+    liftIO $ putStrLn $ unwords [str, show err']
+    assert False $ return ()
+
+
+newBoundVAO
+  :: MonadIO m => m GLuint
+newBoundVAO = do
+  [vao] <- liftIO $ allocaArray 1 $ \ptr -> do
+      glGenVertexArrays 1 ptr
+      peekArray 1 ptr
+  glBindVertexArray vao
+  return vao
+
+
+
+withVAO :: MonadIO m => (GLuint -> IO b) -> m b
+withVAO f = liftIO $ do
+  vao <- newBoundVAO
+  r <- f vao
+  clearErrors "withVAO"
+  glBindVertexArray 0
+  return r
+
+
+newBuffer
+  :: MonadIO m
+  => m GLuint
+newBuffer = liftIO $ do
+  [b] <- allocaArray 1 $ \ptr -> do
+    glGenBuffers 1 ptr
+    peekArray 1 ptr
+  return b
+
+
+withBuffers :: MonadIO m => Int -> ([GLuint] -> m b) -> m b
+withBuffers n = (replicateM n newBuffer >>=)
+
+
+-- | Buffer some geometry into an attribute.
+-- The type variable 'f' should be V0, V1, V2, V3 or V4.
+bufferGeometry
+  :: ( Foldable f
+     , Unbox (f Float)
+     , Storable (f Float)
+     , Finite f
+     , KnownNat (Size f)
+     , MonadIO m
+     )
+  => GLuint
+  -- ^ The attribute location.
+  -> GLuint
+  -- ^ The buffer identifier.
+  -> UV.Vector (f Float)
+  -- ^ The geometry to buffer.
+  -> m ()
+bufferGeometry loc buf as
+  | UV.null as = return ()
+  | otherwise = do
+    let v     = UV.head as
+        asize = UV.length as * sizeOf v
+        n     = fromIntegral $ dim $ toV v
+    glBindBuffer GL_ARRAY_BUFFER buf
+    liftIO $ SV.unsafeWith (convertVec as) $ \ptr ->
+      glBufferData GL_ARRAY_BUFFER (fromIntegral asize) (castPtr ptr) GL_STATIC_DRAW
+    glEnableVertexAttribArray loc
+    glVertexAttribPointer loc n GL_FLOAT GL_FALSE 0 nullPtr
+    clearErrors "bufferGeometry"
+
+
+convertVec
+  :: (Unbox (f Float), Foldable f) => UV.Vector (f Float) -> SV.Vector GLfloat
+convertVec =
+  SV.convert . UV.map realToFrac . UV.concatMap (UV.fromList . F.toList)
+
+
+-- | Binds the given textures to GL_TEXTURE0, GL_TEXTURE1, ... in ascending
+-- order of the texture unit, runs the IO action and then unbinds the textures.
+withBoundTextures :: MonadIO m => [GLuint] -> m a -> m a
+withBoundTextures ts f = do
+  liftIO $ mapM_ (uncurry bindTex) (zip ts [GL_TEXTURE0 ..])
+  a <- f
+  liftIO $ glBindTexture GL_TEXTURE_2D 0
+  return a
+  where bindTex tex u = glActiveTexture u >> glBindTexture GL_TEXTURE_2D tex
+
+
+drawVAO
+  :: MonadIO m
+  => GLuint
+  -- ^ The program
+  -> GLuint
+  -- ^ The vao
+  -> GLenum
+  -- ^ The draw mode
+  -> GLsizei
+  -- ^ The number of vertices to draw
+  -> m ()
+drawVAO program vao mode num = liftIO $ do
+  glUseProgram program
+  glBindVertexArray vao
+  clearErrors "drawBuffer:glBindVertex"
+  glDrawArrays mode 0 num
+  clearErrors "drawBuffer:glDrawArrays"
+
+
+compileOGLShader
+  :: MonadIO m
+  => ByteString
+     -- ^ The shader source
+  -> GLenum
+  -- ^ The shader type (vertex, frag, etc)
+  -> m (Either String GLuint)
+  -- ^ Either an error message or the generated shader handle.
+compileOGLShader src shType = do
+  shader <- liftIO $ glCreateShader shType
+  if shader == 0
+    then return $ Left "Could not create shader"
+    else do
+      success <- liftIO $ do
+        withCString (B8.unpack src) $ \ptr ->
+          with ptr $ \ptrptr -> glShaderSource shader 1 ptrptr nullPtr
+
+        glCompileShader shader
+        with (0 :: GLint) $ \ptr -> do
+          glGetShaderiv shader GL_COMPILE_STATUS ptr
+          peek ptr
+
+      if success == GL_FALSE
+        then do
+          err <- liftIO $ do
+            infoLog <- with (0 :: GLint) $ \ptr -> do
+                glGetShaderiv shader GL_INFO_LOG_LENGTH ptr
+                logsize <- peek ptr
+                allocaArray (fromIntegral logsize) $ \logptr -> do
+                    glGetShaderInfoLog shader logsize nullPtr logptr
+                    peekArray (fromIntegral logsize) logptr
+
+            return $ unlines [ "Could not compile shader:"
+                             , B8.unpack src
+                             , map (toEnum . fromEnum) infoLog
+                             ]
+          return $ Left err
+        else return $ Right shader
+
+
+compileOGLProgram
+  :: MonadIO m
+  => [(String, Integer)]
+  -> [GLuint]
+  -> m (Either String GLuint)
+compileOGLProgram attribs shaders = do
+  (program, success) <- liftIO $ do
+     program <- glCreateProgram
+     forM_ shaders (glAttachShader program)
+     forM_ attribs
+       $ \(name, loc) ->
+         withCString name
+           $ glBindAttribLocation program
+           $ fromIntegral loc
+     glLinkProgram program
+
+     success <- with (0 :: GLint) $ \ptr -> do
+       glGetProgramiv program GL_LINK_STATUS ptr
+       peek ptr
+     return (program, success)
+
+  if success == GL_FALSE
+  then liftIO $ with (0 :: GLint) $ \ptr -> do
+    glGetProgramiv program GL_INFO_LOG_LENGTH ptr
+    logsize <- peek ptr
+    infoLog <- allocaArray (fromIntegral logsize) $ \logptr -> do
+      glGetProgramInfoLog program logsize nullPtr logptr
+      peekArray (fromIntegral logsize) logptr
+    return
+      $ Left
+      $ unlines
+          [ "Could not link program"
+          , map (toEnum . fromEnum) infoLog
+          ]
+  else do
+    liftIO $ forM_ shaders glDeleteShader
+    return $ Right program
+
+
+--------------------------------------------------------------------------------
+-- Uniform marshaling functions
+--------------------------------------------------------------------------------
+
+
+getUniformLocation :: MonadIO m => GLuint -> String -> m GLint
+getUniformLocation program ident = liftIO
+  $ withCString ident
+  $ glGetUniformLocation program
+
+
+class UniformValue a where
+  updateUniform
+    :: MonadIO m
+    => GLuint
+    -- ^ The program
+    -> GLint
+    -- ^ The uniform location
+    -> a
+    -- ^ The value.
+    -> m ()
+
+
+clearUniformUpdateError :: (MonadIO m, Show a) => GLuint -> GLint -> a -> m ()
+clearUniformUpdateError prog loc val = glGetError >>= \case
+  0 -> return ()
+  e -> do
+    let buf = replicate 256 ' '
+    ident <- liftIO $ withCString buf
+      $ \strptr -> with 0
+      $ \szptr  -> do
+        glGetActiveUniformName prog (fromIntegral loc) 256 szptr strptr
+        sz <- peek szptr
+        peekCAStringLen (strptr, fromIntegral sz)
+    liftIO
+      $ putStrLn
+      $ unwords
+          [ "Could not update uniform"
+          , ident
+          , "with value"
+          , show val
+          , ", encountered error (" ++ show e ++ ")"
+          , show (GL_INVALID_OPERATION :: Integer, "invalid operation" :: String)
+          , show (GL_INVALID_VALUE :: Integer, "invalid value" :: String)
+          ]
+    assert False $ return ()
+
+
+instance UniformValue Bool where
+  updateUniform p loc bool = liftIO $ do
+    glUniform1i loc $ if bool then 1 else 0
+    clearUniformUpdateError p loc bool
+
+instance UniformValue Int where
+  updateUniform p loc enum = liftIO $ do
+    glUniform1i loc $ fromIntegral $ fromEnum enum
+    clearUniformUpdateError p loc enum
+
+instance UniformValue Float where
+  updateUniform p loc float = liftIO $ do
+    glUniform1f loc $ realToFrac float
+    clearUniformUpdateError p loc float
+
+instance UniformValue Double where
+  updateUniform p loc d = liftIO $ do
+    glUniform1f loc $ realToFrac d
+    clearUniformUpdateError p loc d
+
+instance UniformValue (V2 Float) where
+  updateUniform p loc v = liftIO $ do
+    let V2 x y = fmap realToFrac v
+    glUniform2f loc x y
+    clearUniformUpdateError p loc v
+
+instance UniformValue (V3 Float) where
+  updateUniform p loc v = liftIO $ do
+    let V3 x y z = fmap realToFrac v
+    glUniform3f loc x y z
+    clearUniformUpdateError p loc v
+
+instance UniformValue (V4 Float) where
+  updateUniform p loc v = liftIO $ do
+    let (V4 r g b a) = realToFrac <$> v
+    glUniform4f loc r g b a
+    clearUniformUpdateError p loc v
+
+instance UniformValue (M44 Float) where
+  updateUniform p loc val = liftIO $ do
+    with val $ glUniformMatrix4fv loc 1 GL_TRUE . castPtr
+    clearUniformUpdateError p loc val
+
+instance UniformValue (V2 Int) where
+  updateUniform p loc v = liftIO $ do
+    let V2 x y = fmap fromIntegral v
+    glUniform2i loc x y
+    clearUniformUpdateError p loc v
+
+instance UniformValue (Int,Int) where
+  updateUniform p loc = updateUniform p loc . uncurry V2
+
+
+--------------------------------------------------------------------------------
+-- Matrix helpers
+--------------------------------------------------------------------------------
+
+
+mat4Translate :: Num a => V3 a -> M44 a
+mat4Translate = mkTransformationMat identity
+
+
+mat4Rotate :: (Num a, Epsilon a, Floating a) => a -> V3 a -> M44 a
+mat4Rotate phi v = mkTransformation (axisAngle v phi) (V3 0 0 0)
+
+
+mat4Scale :: Num a => V3 a -> M44 a
+mat4Scale (V3 x y z) =
+    V4 (V4 x 0 0 0)
+       (V4 0 y 0 0)
+       (V4 0 0 z 0)
+       (V4 0 0 0 1)
+
+
+orthoProjection
+  :: Integral a
+  => V2 a
+  -- ^ The window width and height
+  -> M44 Float
+orthoProjection (V2 ww wh) =
+  let (hw,hh) = (fromIntegral ww, fromIntegral wh)
+  in ortho 0 hw hh 0 0 1
+
+
+boundingBox :: (Unbox a, Real a, Fractional a) => UV.Vector (V2 a) -> (V2 a, V2 a)
+boundingBox vs
+  | UV.null vs = (0,0)
+  | otherwise = UV.foldl' f (br,tl) vs
+  where mn a = min a . realToFrac
+        mx a = max a . realToFrac
+        f (a, b) c = (mn <$> a <*> c, mx <$> b <*> c)
+        inf = 1/0
+        ninf = (-1)/0
+        tl = V2 ninf ninf
+        br = V2 inf inf
diff --git a/src/Typograffiti/Glyph.hs b/src/Typograffiti/Glyph.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/Glyph.hs
@@ -0,0 +1,54 @@
+module Typograffiti.Glyph where
+
+
+import Linear
+
+
+-- | The size of one freetype font character.
+-- https://www.freetype.org/freetype2/docs/tutorial/step1.html#section-5
+data CharSize = CharSize
+  { charSizeWidth  :: Int
+    -- ^ Width of a character specified in 1/64 of points.
+  , charSizeHeight :: Int
+    -- ^ Height of a character specified in 1/64 of points.
+  , charSizeWidthDPI :: Int
+    -- ^ Horizontal device resolution
+  , charSizeHeightDPI :: Int
+    -- ^ Vertical device resolution
+  } deriving (Show, Eq, Ord)
+
+
+data GlyphSize = GlyphSizeByChar CharSize
+               | GlyphSizeInPixels Int Int
+               deriving (Show, Eq, Ord)
+
+
+pixelWidth :: GlyphSize -> Float
+pixelWidth (GlyphSizeInPixels w h)
+  | w == 0 = fromIntegral h
+  | otherwise = fromIntegral w
+pixelWidth (GlyphSizeByChar (CharSize w h xdpi ydpi)) =
+  let dpi = if xdpi == 0 then ydpi else xdpi
+      sz  = if w == 0 then h else w
+  in fromIntegral sz * fromIntegral dpi / 72
+
+
+pixelHeight :: GlyphSize -> Float
+pixelHeight (GlyphSizeInPixels w h)
+  | h == 0 = fromIntegral w
+  | otherwise = fromIntegral h
+pixelHeight (GlyphSizeByChar (CharSize w h xdpi ydpi)) =
+  let dpi = if ydpi == 0 then xdpi else ydpi
+      sz  = if h == 0 then w else h
+  in fromIntegral sz * fromIntegral dpi / 72
+
+
+-- | https://www.freetype.org/freetype2/docs/tutorial/step2.html
+data GlyphMetrics = GlyphMetrics
+  { glyphTexBB       :: (V2 Int, V2 Int)
+  , glyphTexSize     :: V2 Int
+  , glyphSize        :: V2 Int
+  , glyphHoriBearing :: V2 Int
+  , glyphVertBearing :: V2 Int
+  , glyphAdvance     :: V2 Int
+  } deriving (Show, Eq)
diff --git a/src/Typograffiti/Store.hs b/src/Typograffiti/Store.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/Store.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+-- |
+-- Module:     Typograffiti.Monad
+-- Copyright:  (c) 2018 Schell Scivally
+-- License:    MIT
+-- Maintainer: Schell Scivally <schell@takt.com>
+--
+-- A storage context an ops for rendering text with multiple fonts
+-- and sizes, hiding the details of the Atlas and WordCache.
+module Typograffiti.Store where
+
+
+import           Control.Concurrent.STM (TMVar, atomically, newTMVar, putTMVar,
+                                         readTMVar, takeTMVar)
+import           Control.Monad.Except   (MonadError (..), liftEither)
+import           Control.Monad.IO.Class (MonadIO (..))
+import           Data.Map               (Map)
+import qualified Data.Map               as M
+import           Data.Set               (Set)
+import qualified Data.Set               as S
+import           Linear
+
+
+import           Typograffiti.Atlas
+import           Typograffiti.Cache
+import           Typograffiti.Glyph
+
+
+-- | A pre-rendered bit of text, ready to display given
+-- some post compilition transformations. Also contains
+-- the text size.
+data RenderedText t m = RenderedText
+  { drawRenderedText   :: t -> m ()
+  , sizeOfRenderedText :: V2 Int
+  }
+
+
+data Font t = Font
+  { fontAtlas     :: Atlas
+  , fontWordCache :: WordCache t
+  }
+
+
+data TextRenderingData t = TextRenderingData
+  { textRenderingDataAllocWord :: Atlas -> String -> IO (Either TypograffitiError (AllocatedRendering t))
+  -- ^ The operation used to alloc a word.
+  -- Generate geometry, use a shader program, set uniforms, etc.
+  , textRenderingDataFontMap   :: Map (FilePath, GlyphSize) (Font t)
+  -- ^ The cached fonts.
+  , textRenderingDataCharSet   :: Set Char
+  -- ^ The character set to have available in all allocated Atlas types.
+  }
+
+
+-- | Stored fonts at specific sizes.
+newtype FontStore t = FontStore
+  { unFontStore :: TMVar (TextRenderingData t)}
+
+
+getTextRendering
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     , Layout t
+     )
+  => FontStore t
+  -- ^ The font store.
+  -> FilePath
+  -- ^ The path to the font to use
+  -- for rendering.
+  -> GlyphSize
+  -- ^ The size of the font glyphs.
+  -> String
+  -- ^ The string to render.
+  -> m (RenderedText t m)
+  -- ^ The rendered text, ready to draw to the screen.
+getTextRendering store file sz str = do
+  let mvar = unFontStore store
+  s    <- liftIO $ atomically $ readTMVar mvar
+  font <- case M.lookup (file, sz) $ textRenderingDataFontMap s of
+    Nothing   -> allocFont store file sz
+    Just font -> return font
+  (draw, tsz, cache) <-
+    loadText
+      (\x y -> liftIO (textRenderingDataAllocWord s x y) >>= liftEither)
+      (fontAtlas font)
+      (fontWordCache font)
+      str
+  liftIO
+    $ atomically $ do
+      s1 <- takeTMVar mvar
+      let alterf Nothing               = Just $ Font (fontAtlas font) cache
+          alterf (Just (Font atlas _)) = Just $ Font atlas cache
+          fontmap = M.alter alterf (file,sz)
+            $ textRenderingDataFontMap s1
+      putTMVar mvar s1{ textRenderingDataFontMap = fontmap }
+  return RenderedText
+    { drawRenderedText   = liftIO . draw
+    , sizeOfRenderedText = tsz
+    }
+
+
+newDefaultFontStore
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     , Integral i
+     )
+  => IO (V2 i)
+  -> m (FontStore [TextTransform])
+newDefaultFontStore getDims = do
+  aw <- makeDefaultAllocateWord getDims
+  let dat = TextRenderingData
+        { textRenderingDataAllocWord = aw
+        , textRenderingDataFontMap   = mempty
+        , textRenderingDataCharSet   = S.fromList asciiChars
+        }
+  FontStore
+    <$> liftIO (atomically $ newTMVar dat)
+
+
+allocFont
+  :: ( MonadIO m
+     , MonadError TypograffitiError m
+     , Layout t
+     )
+  => FontStore t
+  -> FilePath
+  -> GlyphSize
+  -> m (Font t)
+allocFont store file sz = do
+  let mvar = unFontStore store
+  s     <- liftIO $ atomically $ takeTMVar mvar
+  atlas <-
+    allocAtlas
+      file
+      sz
+      $ S.toList
+      $ textRenderingDataCharSet s
+  let fontmap = textRenderingDataFontMap s
+      font = Font
+        { fontAtlas     = atlas
+        , fontWordCache = mempty
+        }
+  liftIO
+    $ atomically
+    $ putTMVar mvar
+    $ s{ textRenderingDataFontMap = M.insert (file, sz) font fontmap }
+  return font
diff --git a/src/Typograffiti/Utils.hs b/src/Typograffiti/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Typograffiti/Utils.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
+module Typograffiti.Utils (
+   module FT
+ , FreeTypeT
+ , FreeTypeIO
+ , getAdvance
+ , getCharIndex
+ , getLibrary
+ , getKerning
+ , glyphFormatString
+ , hasKerning
+ , loadChar
+ , loadGlyph
+ , newFace
+ , setCharSize
+ , setPixelSizes
+ , withFreeType
+ , runFreeType
+) where
+
+import           Control.Monad.IO.Class (MonadIO, liftIO)
+import           Control.Monad.Except
+import           Control.Monad.State.Strict
+import           Control.Monad (unless)
+import           Graphics.Rendering.FreeType.Internal                   as FT
+import           Graphics.Rendering.FreeType.Internal.PrimitiveTypes    as FT
+import           Graphics.Rendering.FreeType.Internal.Library           as FT
+import           Graphics.Rendering.FreeType.Internal.FaceType          as FT
+import           Graphics.Rendering.FreeType.Internal.Face as FT hiding (generic)
+import           Graphics.Rendering.FreeType.Internal.GlyphSlot         as FT
+import           Graphics.Rendering.FreeType.Internal.Bitmap            as FT
+import           Graphics.Rendering.FreeType.Internal.Vector            as FT
+import           Foreign                                                as FT
+import           Foreign.C.String                                       as FT
+
+-- TODO: Tease out the correct way to handle errors.
+-- They're kinda thrown all willy nilly.
+
+type FreeTypeT m = ExceptT String (StateT FT_Library m)
+type FreeTypeIO = FreeTypeT IO
+
+
+glyphFormatString :: FT_Glyph_Format -> String
+glyphFormatString fmt
+    | fmt == ft_GLYPH_FORMAT_COMPOSITE = "ft_GLYPH_FORMAT_COMPOSITE"
+    | fmt == ft_GLYPH_FORMAT_OUTLINE = "ft_GLYPH_FORMAT_OUTLINE"
+    | fmt == ft_GLYPH_FORMAT_PLOTTER = "ft_GLYPH_FORMAT_PLOTTER"
+    | fmt == ft_GLYPH_FORMAT_BITMAP = "ft_GLYPH_FORMAT_BITMAP"
+    | otherwise = "ft_GLYPH_FORMAT_NONE"
+
+
+liftE :: MonadIO m => String -> IO (Either FT_Error a) -> FreeTypeT m a
+liftE msg f = liftIO f >>= \case
+  Left e  -> fail $ unwords [msg, show e]
+  Right a -> return a
+
+
+runIOErr :: MonadIO m => String -> IO FT_Error -> FreeTypeT m ()
+runIOErr msg f = do
+  e <- liftIO f
+  unless (e == 0) $ fail $ unwords [msg, show e]
+
+
+runFreeType :: MonadIO m => FreeTypeT m a -> m (Either String (a, FT_Library))
+runFreeType f = do
+  (e,lib) <- liftIO $ alloca $ \p -> do
+    e <- ft_Init_FreeType p
+    lib <- peek p
+    return (e,lib)
+  if e /= 0
+    then do
+      _ <- liftIO $ ft_Done_FreeType lib
+      return $ Left $ "Error initializing FreeType2:" ++ show e
+    else fmap (,lib) <$> evalStateT (runExceptT f) lib
+
+withFreeType :: MonadIO m => Maybe FT_Library -> FreeTypeT m a -> m (Either String a)
+withFreeType Nothing f = runFreeType f >>= \case
+  Left e -> return $ Left e
+  Right (a,lib) -> do
+    _ <- liftIO $ ft_Done_FreeType lib
+    return $ Right a
+withFreeType (Just lib) f = evalStateT (runExceptT f) lib
+
+getLibrary :: MonadIO m => FreeTypeT m FT_Library
+getLibrary = lift get
+
+newFace :: MonadIO m => FilePath -> FreeTypeT m FT_Face
+newFace fp = do
+  ft <- lift get
+  liftE "ft_New_Face" $ withCString fp $ \str ->
+    alloca $ \ptr -> ft_New_Face ft str 0 ptr >>= \case
+      0 -> Right <$> peek ptr
+      e -> return $ Left e
+
+setCharSize :: (MonadIO m, Integral i) => FT_Face -> i -> i -> i -> i -> FreeTypeT m ()
+setCharSize ff w h dpix dpiy = runIOErr "ft_Set_Char_Size" $
+  ft_Set_Char_Size ff (fromIntegral w)    (fromIntegral h)
+                      (fromIntegral dpix) (fromIntegral dpiy)
+
+setPixelSizes :: (MonadIO m, Integral i) => FT_Face -> i -> i -> FreeTypeT m ()
+setPixelSizes ff w h =
+  runIOErr "ft_Set_Pixel_Sizes" $ ft_Set_Pixel_Sizes ff (fromIntegral w) (fromIntegral h)
+
+getCharIndex :: (MonadIO m, Integral i)
+             => FT_Face -> i -> FreeTypeT m FT_UInt
+getCharIndex ff ndx = liftIO $ ft_Get_Char_Index ff $ fromIntegral ndx
+
+loadGlyph :: MonadIO m => FT_Face -> FT_UInt -> FT_Int32 -> FreeTypeT m ()
+loadGlyph ff fg flags = runIOErr "ft_Load_Glyph" $ ft_Load_Glyph ff fg flags
+
+loadChar :: MonadIO m => FT_Face -> FT_ULong -> FT_Int32 -> FreeTypeT m ()
+loadChar ff char flags = runIOErr "ft_Load_Char" $ ft_Load_Char ff char flags
+
+hasKerning :: MonadIO m => FT_Face -> FreeTypeT m Bool
+hasKerning = liftIO . ft_HAS_KERNING
+
+getKerning :: MonadIO m => FT_Face -> FT_UInt -> FT_UInt -> FT_Kerning_Mode -> FreeTypeT m (Int,Int)
+getKerning ff prevNdx curNdx flags = liftE "ft_Get_Kerning" $ alloca $ \ptr ->
+  ft_Get_Kerning ff prevNdx curNdx (fromIntegral flags) ptr >>= \case
+    0 -> do FT_Vector vx vy <- peek ptr
+            return $ Right (fromIntegral vx, fromIntegral vy)
+    e -> return $ Left e
+
+getAdvance :: MonadIO m => FT_GlyphSlot -> FreeTypeT m (Int,Int)
+getAdvance slot = do
+  FT_Vector vx vy <- liftIO $ peek $ advance slot
+  return (fromIntegral vx, fromIntegral vy)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/typograffiti.cabal b/typograffiti.cabal
new file mode 100644
--- /dev/null
+++ b/typograffiti.cabal
@@ -0,0 +1,102 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.30.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: b6bda4deeb70ae65eaeeb1801fcc763f81f9474cdd3e74d8ab791b5e0bf4b539
+
+name:           typograffiti
+version:        0.1.0.0
+synopsis:       Display TTF fonts in OpenGL. Includes caching for fast rendering.
+description:    Please see the README on GitHub at <https://github.com/githubuser/typograffiti#readme>
+category:       Graphics
+homepage:       https://github.com/schell/typograffiti#readme
+bug-reports:    https://github.com/schell/typograffiti/issues
+author:         Schell Scivally
+maintainer:     schell@takt.com
+copyright:      2018 Schell Scivally
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/schell/typograffiti
+
+library
+  exposed-modules:
+      Typograffiti
+      Typograffiti.Atlas
+      Typograffiti.Cache
+      Typograffiti.GL
+      Typograffiti.Glyph
+      Typograffiti.Store
+      Typograffiti.Utils
+  other-modules:
+      Paths_typograffiti
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , freetype2
+    , gl
+    , linear
+    , mtl
+    , pretty-show
+    , stm
+    , template-haskell
+    , vector
+  default-language: Haskell2010
+
+executable typograffiti-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_typograffiti
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , filepath
+    , freetype2
+    , gl
+    , linear
+    , mtl
+    , pretty-show
+    , sdl2
+    , stm
+    , template-haskell
+    , typograffiti
+    , vector
+  default-language: Haskell2010
+
+test-suite typograffiti-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_typograffiti
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , freetype2
+    , gl
+    , linear
+    , mtl
+    , pretty-show
+    , stm
+    , template-haskell
+    , typograffiti
+    , vector
+  default-language: Haskell2010