Initial commit

3 files changed, 2006 insertions, 0 deletions

diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs
new file mode 100644
index 0000000..bfa1596
--- /dev/null
+++ b/src/Graphics/Fountainhead/Parser.hs
@@ -0,0 +1,1198 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | Font parser.
+module Graphics.Fountainhead.Parser
+    ( cmapTableP
+    , cvTableP
+    , f2Dot14P
+    , fixedP
+    , fontDirectoryP
+    , fpgmTableP
+    , glyfTableP
+    , hdmxTableP
+    , headTableP
+    , hheaTableP
+    , hmtxTableP
+    , longDateTimeP
+    , longLocaTableP
+    , maxpTableP
+    , nameTableP
+    , os2TableP
+    , panoseP
+    , parseTable
+    , pascalStringP
+    , postTableP
+    , prepTableP
+    , shortLocaTableP
+    , word24P
+    ) where
+
+import Control.Applicative (Alternative(..))
+import Control.Monad (foldM)
+import Data.Bits (Bits(..))
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Builder as ByteString.Builder
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Data.Foldable (Foldable(..))
+import Data.Int (Int8, Int16)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Functor (($>))
+import Data.List (nub, sort, sortOn, nubBy, sortBy)
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Maybe (fromMaybe)
+import Data.Time
+    ( LocalTime(..)
+    , TimeOfDay(..)
+    , addDays
+    , secondsToDiffTime
+    , timeToTimeOfDay
+    )
+import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import Data.Void (Void)
+import Data.Word (Word8, Word16, Word32)
+import GHC.Records (HasField(..))
+import Graphics.Fountainhead.TrueType
+    ( BArmStyle(..)
+    , BContrast(..)
+    , BFamilyType(..)
+    , BMidline(..)
+    , BLetterform(..)
+    , BProportion(..)
+    , BSerifStyle(..)
+    , BStrokeVariation(..)
+    , BWeight(..)
+    , BXHeight(..)
+    , CVTable(..)
+    , CmapSubtable(..)
+    , CmapTable(..)
+    , CmapEncoding(..)
+    , CmapFormat0Table(..)
+    , CmapFormat2Subheader(..)
+    , CmapFormat2Table(..)
+    , CmapFormat4Table(..)
+    , CmapFormat6Table(..)
+    , CmapGroup(..)
+    , CmapFormat8Table(..)
+    , CmapFormat10Table(..)
+    , CmapFormat12Table(..)
+    , CmapFormat13Table
+    , CmapFormat14Table(..)
+    , ComponentGlyphFlags(..)
+    , ComponentGlyphPartDescription(..)
+    , CompoundGlyphDefinition(..)
+    , FpgmTable(..)
+    , FontDirectionHint(..)
+    , FontDirectory(..)
+    , FontStyle(..)
+    , GlyfTable(..)
+    , GlyphArgument(..)
+    , GlyphCoordinate(..)
+    , GlyphDefinition(..)
+    , GlyphDescription(..)
+    , GlyphTransformationOption(..)
+    , HdmxTable(..)
+    , DeviceRecord(..)
+    , HeadTable(..)
+    , HheaTable(..)
+    , HmtxTable(..)
+    , LocaTable(..)
+    , LongHorMetric(..)
+    , MaxpTable(..)
+    , NameRecord(..)
+    , NameTable(..)
+    , OffsetSubtable(..)
+    , OutlineFlag(..)
+    , OpenMaxpTable(..)
+    , Os2BaseFields(..)
+    , Os2MicrosoftFields(..)
+    , Os2Version1Fields(..)
+    , Os2Version4Fields(..)
+    , Os2Version5Fields(..)
+    , Os2Table(..)
+    , Panose(..)
+    , PostFormat2Table(..)
+    , PostHeader(..)
+    , PostSubtable(..)
+    , PostTable(..)
+    , PrepTable(..)
+    , SimpleGlyphDefinition(..)
+    , TableDirectory(..)
+    , TrueMaxpTable(..)
+    , UVSOffset(..)
+    , UVSMapping(..)
+    , UnicodeValueRange(..)
+    , VariationSelectorMap
+    , unLocaTable
+    )
+import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..))
+import Text.Megaparsec ((<?>))
+import qualified Text.Megaparsec as Megaparsec
+import qualified Text.Megaparsec.Byte.Binary as Megaparsec.Binary
+
+type Parser = Megaparsec.Parsec Void ByteString
+
+-- * Font directory
+
+offsetSubtableP :: Parser OffsetSubtable
+offsetSubtableP = OffsetSubtable
+    <$> Megaparsec.Binary.word32be
+    <*> (fromIntegral <$> Megaparsec.Binary.word16be)
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+
+tagP :: Parser ByteString
+tagP = ByteString.Lazy.toStrict
+    . ByteString.Builder.toLazyByteString
+    . ByteString.Builder.word32BE
+    <$> Megaparsec.Binary.word32be
+
+tableDirectoryP :: Parser TableDirectory
+tableDirectoryP = TableDirectory
+    <$> tagP
+    <*> Megaparsec.Binary.word32be
+    <*> (fromIntegral <$> Megaparsec.Binary.word32be)
+    <*> (fromIntegral <$> Megaparsec.Binary.word32be)
+
+fontDirectoryP :: Parser FontDirectory
+fontDirectoryP = do
+    offsetSubtable'@OffsetSubtable{ numTables } <- offsetSubtableP
+    tableDirectories <- Megaparsec.count numTables tableDirectoryP
+    pure $ FontDirectory
+        { offsetSubtable = offsetSubtable'
+        , tableDirectory = tableDirectories
+        }
+
+-- * Name table
+
+nameTableP :: Parser NameTable
+nameTableP = do
+    format' <- Megaparsec.Binary.word16be
+    count' <- fromIntegral <$> Megaparsec.Binary.word16be
+    stringOffset' <- fromIntegral <$> Megaparsec.Binary.word16be
+    nameRecord' <- Megaparsec.count count' nameRecordP
+    -- 12 is the size of a single record, 6 is the header size.
+    let padding = stringOffset' - count' * 12 - 6
+    Megaparsec.skipCount padding Megaparsec.Binary.word8
+    variable' <- Megaparsec.takeRest
+    pure $ NameTable
+        { format = format'
+        , nameRecord = nameRecord'
+        , variable = parseVariable variable' <$> nameRecord'
+        }
+  where
+    parseVariable variable' NameRecord{ offset, length } =
+        ByteString.take length $ ByteString.drop offset variable'
+
+nameRecordP :: Parser NameRecord
+nameRecordP = NameRecord
+    <$> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> (fromIntegral <$> Megaparsec.Binary.word16be)
+    <*> (fromIntegral <$> Megaparsec.Binary.word16be)
+
+-- * 'cvt ' table
+
+cvTableP :: Parser CVTable
+cvTableP = CVTable
+    <$> Megaparsec.many Megaparsec.Binary.int16be
+    <* Megaparsec.eof
+
+-- * Maximum profile table
+
+trueMaxpTableP :: Parser TrueMaxpTable
+trueMaxpTableP
+    = Megaparsec.chunk (ByteString.pack [0, 1, 0, 0])
+    *> subparser
+  where
+    subparser =
+        TrueMaxpTable (Fixed32 0x00010000)
+            <$> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+            <*> Megaparsec.Binary.word16be
+
+openMaxpTableP :: Parser OpenMaxpTable
+openMaxpTableP
+    = Megaparsec.chunk (ByteString.pack [0, 0, 0x50, 0])
+    *> subparser
+  where
+    subparser =
+        OpenMaxpTable (Fixed32 0x00005000)
+            <$> Megaparsec.Binary.word16be
+            <* Megaparsec.eof
+
+maxpTableP :: Parser MaxpTable
+maxpTableP
+    = TrueMaxp <$> trueMaxpTableP
+    <|> OpenMaxp <$> openMaxpTableP
+
+-- * Horizontal header table
+
+hheaTableP :: Parser HheaTable
+hheaTableP = HheaTable
+    <$> fixedP
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <* Megaparsec.Binary.int16be
+    <* Megaparsec.Binary.int16be
+    <* Megaparsec.Binary.int16be
+    <* Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <* Megaparsec.eof
+
+-- * Font header table
+
+headTableP :: Parser HeadTable
+headTableP = HeadTable
+    <$> fixedP
+    <*> fixedP
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> longDateTimeP
+    <*> longDateTimeP
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> fontStyleP
+    <*> Megaparsec.Binary.word16be
+    <*> fontDirectionHintP
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <* Megaparsec.eof
+
+fontStyleP :: Parser FontStyle
+fontStyleP = go <$> Megaparsec.Binary.word16be
+  where
+    go fontStyle' = FontStyle
+        { bold = testBit fontStyle' 0
+        , italic = testBit fontStyle' 1
+        , underline = testBit fontStyle' 2
+        , outline = testBit fontStyle' 3
+        , shadow = testBit fontStyle' 4
+        , condensed = testBit fontStyle' 5
+        , extended = testBit fontStyle' 6
+        }
+
+fontDirectionHintP :: Parser FontDirectionHint
+fontDirectionHintP
+    = (Megaparsec.chunk (ByteString.pack [0, 0]) $> MixedDirectionalGlyphs)
+    <|> (Megaparsec.chunk (ByteString.pack [0, 1]) $> StronglyLeftToRightGlyphs)
+    <|> (Megaparsec.chunk (ByteString.pack [0, 2]) $> LeftToRightGlyphsWithNeutrals)
+    <|> (Megaparsec.chunk (ByteString.pack [0xff, 0xff]) $> StronglyRightToLeftGlyphs)
+    <|> (Megaparsec.chunk (ByteString.pack [0xff, 0xfe]) $> RightToLeftGlyphsWithNeutrals)
+
+-- * Glyph data location table
+
+longLocaTableP :: Parser LocaTable
+longLocaTableP = LongLocaTable
+    <$> vectorP Megaparsec.Binary.word32be
+    <?> "loca table, long version"
+
+shortLocaTableP :: Parser LocaTable
+shortLocaTableP = ShortLocaTable
+    <$> vectorP Megaparsec.Binary.word16be
+    <?> "loca table, short version"
+
+-- * Horizontal metrics table
+
+longHorMetricP :: Parser LongHorMetric
+longHorMetricP = LongHorMetric
+    <$> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
+
+hmtxTableP :: Int -> Parser HmtxTable
+hmtxTableP numOfLongHorMetrics = HmtxTable
+    <$> countP numOfLongHorMetrics longHorMetricP
+    <*> Megaparsec.many Megaparsec.Binary.int16be
+
+-- * Glyph name and PostScript font table
+
+postTableP :: Parser PostTable
+postTableP = do
+    header'@PostHeader{ format } <- postHeaderP
+    subtable' <- case format of
+        Fixed32 0x00010000 -> pure None
+        Fixed32 0x00020000 -> PostFormat2 <$> postFormat2TableP
+        Fixed32 0x00025000 -> PostFormat25 <$> postFormat25TableP
+        Fixed32 0x00030000 -> pure None
+        Fixed32 0x00040000 -> PostFormat4 <$> postFormat4TableP
+        _ -> fail $ "Unsupported post table format: " <> show format
+    Megaparsec.eof
+    pure $ PostTable
+        { postHeader = header'
+        , postSubtable = subtable'
+        }
+
+postFormat2TableP :: Parser PostFormat2Table
+postFormat2TableP = do
+    numberOfGlyphs <- fromIntegral <$> Megaparsec.Binary.word16be
+    glyphNameIndex' <- Megaparsec.count numberOfGlyphs Megaparsec.Binary.word16be
+    rest <- Megaparsec.many pascalStringP
+    pure $ PostFormat2Table
+        { glyphNameIndex = Vector.fromList glyphNameIndex'
+        , names = Vector.fromList rest
+        }
+
+postFormat25TableP :: Parser (Vector Int8)
+postFormat25TableP = Megaparsec.Binary.word16be
+    >>= fmap Vector.fromList
+    . flip Megaparsec.count Megaparsec.Binary.int8
+    . fromIntegral
+
+postFormat4TableP :: Parser (Vector Word16)
+postFormat4TableP = Vector.fromList
+    <$> Megaparsec.many Megaparsec.Binary.word16be
+
+postHeaderP :: Parser PostHeader
+postHeaderP = PostHeader
+    <$> fixedP
+    <*> fixedP
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+
+-- * Font program table
+
+fpgmTableP :: Parser FpgmTable
+fpgmTableP = FpgmTable
+    <$> vectorP Megaparsec.Binary.word8
+
+-- * Prep table
+
+prepTableP :: Parser PrepTable
+prepTableP = PrepTable
+    <$> vectorP Megaparsec.Binary.word8
+
+-- * Horizontal device metrics table
+
+deviceRecordP :: Int -> Parser DeviceRecord
+deviceRecordP size = do
+    pixelSize' <- Megaparsec.Binary.word8
+    maximumWidth' <- Megaparsec.Binary.word8
+    widths' <- vectorNP size Megaparsec.Binary.word8
+    let paddingLength = 4 - ((Vector.length widths' + 2) `mod` 4)
+    Megaparsec.skipCount paddingLength
+        $ Megaparsec.chunk
+        $ ByteString.pack [0]
+    pure $ DeviceRecord
+        { pixelSize = pixelSize'
+        , maximumWidth = maximumWidth'
+        , widths = widths'
+        }
+
+hdmxTableP :: Parser HdmxTable
+hdmxTableP = do
+    Megaparsec.chunk $ ByteString.pack [0, 0]
+    numberOfDeviceRecords <- fromIntegral <$> Megaparsec.Binary.int16be
+    sizeOfDeviceRecord <- fromIntegral <$> Megaparsec.Binary.int32be
+    records' <- Megaparsec.count numberOfDeviceRecords
+        $ deviceRecordP sizeOfDeviceRecord
+    Megaparsec.eof >> pure (HdmxTable 0 records')
+
+-- * Glyph outline table
+
+glyphDescriptionP :: Parser GlyphDescription
+glyphDescriptionP = do
+    numberOfContours' <- fromIntegral
+        <$> Megaparsec.Binary.int16be
+        <?> "numberOfContours"
+    xMin' <- Megaparsec.Binary.int16be <?> "xMin"
+    yMin' <- Megaparsec.Binary.int16be <?> "yMin"
+    xMax' <- Megaparsec.Binary.int16be <?> "xMax"
+    yMax' <- Megaparsec.Binary.int16be <?> "yMax"
+    glyphDefinition <-
+        if numberOfContours' >= 0
+        then SimpleGlyph <$> simpleGlyphDefinitionP numberOfContours'
+        else CompoundGlyph <$> compoundGlyphDefinitionP
+    pure $ GlyphDescription
+        { numberOfContours = numberOfContours'
+        , xMin = xMin'
+        , yMin = yMin'
+        , xMax = xMax'
+        , yMax = yMax'
+        , definition = glyphDefinition
+        }
+
+glyphInstructionsP :: Parser (Vector Word8)
+glyphInstructionsP = Megaparsec.Binary.word16be
+    >>= flip vectorNP (Megaparsec.Binary.word8 <?> "compound glyph instruction")
+    . fromIntegral
+
+compoundGlyphDefinitionP :: Parser CompoundGlyphDefinition
+compoundGlyphDefinitionP = do
+    components' <- componentGlyphPartDescriptionP mempty
+    let instructions' =
+            if Vector.any (weHaveInstructions . getField @"flags") components'
+            then glyphInstructionsP
+            else pure mempty
+    CompoundGlyphDefinition components' <$> instructions'
+
+componentGlyphPartDescriptionP
+    ::Vector ComponentGlyphPartDescription
+    -> Parser (Vector ComponentGlyphPartDescription)
+componentGlyphPartDescriptionP accumulator = do
+    flags' <- Megaparsec.Binary.word16be <?> "flags"
+    glyphIndex' <- Megaparsec.Binary.word16be <?> "glyphIndex"
+    let arg1And2AreWords = testBit flags' 0
+        argsAreXyValues = testBit flags' 1
+        weHaveAScale =  testBit flags' 3
+        weHaveAnXAndYScale =  testBit flags' 6
+        weHaveATwoByTwo =  testBit flags' 7
+    argument1 <- glyphArgumentP arg1And2AreWords argsAreXyValues <?> "argument1"
+    argument2 <- glyphArgumentP arg1And2AreWords argsAreXyValues <?> "argument2"
+    transformationOption' <- transformationOptionP weHaveAScale weHaveAnXAndYScale weHaveATwoByTwo
+        <?> "transformation option"
+
+    let updated = Vector.snoc accumulator $ ComponentGlyphPartDescription
+            { flags = ComponentGlyphFlags
+                { roundXyToGrid = testBit flags' 2
+                , weHaveInstructions = testBit flags' 8
+                , useMyMetrics = testBit flags' 9
+                , overlapCompound = testBit flags' 10
+                }
+            , glyphIndex = glyphIndex'
+            , argument1 = argument1
+            , argument2 = argument2
+            , transformationOption = transformationOption'
+            }
+    -- MORE_COMPONENTS.
+    if testBit flags' 5 then componentGlyphPartDescriptionP updated else pure updated
+
+transformationOptionP :: Bool -> Bool -> Bool -> Parser GlyphTransformationOption
+transformationOptionP True _ _ = GlyphScale <$> f2Dot14P <?> "scale"
+transformationOptionP _ True _ = GlyphXyScale
+    <$> f2Dot14P
+    <*> f2Dot14P
+    <?> "xy-scale"
+transformationOptionP _ _ True = Glyph2By2Scale
+    <$> f2Dot14P
+    <*> f2Dot14P
+    <*> f2Dot14P
+    <*> f2Dot14P
+    <?> "2 by 2 transformation"
+transformationOptionP _ _ _ = pure GlyphNoScale
+
+glyphArgumentP :: Bool -> Bool -> Parser GlyphArgument
+glyphArgumentP True True = GlyphInt16Argument
+    <$> Megaparsec.Binary.int16be
+    <?> "int16 argument"
+glyphArgumentP True False = GlyphWord16Argument
+    <$> Megaparsec.Binary.word16be
+    <?> "uint16 argument"
+glyphArgumentP False True = GlyphInt8Argument
+    <$> Megaparsec.Binary.int8
+    <?> "int8 argument"
+glyphArgumentP False False = GlyphWord8Argument
+    <$> Megaparsec.Binary.word8
+    <?> "uint8 argument"
+
+simpleGlyphDefinitionP :: Int -> Parser SimpleGlyphDefinition
+simpleGlyphDefinitionP numberOfContours' = do
+    endPtsOfContours' <- vectorNP numberOfContours' Megaparsec.Binary.word16be
+        <?> "endPtsOfContours"
+    let numberOfPoints =
+            if Vector.null endPtsOfContours'
+            then 0
+            else fromIntegral $ Vector.last endPtsOfContours'
+    instructionLength <- fromIntegral
+        <$> Megaparsec.Binary.word16be
+        <?> "instructionLength"
+    instructions' <- vectorNP instructionLength
+            (Megaparsec.Binary.word8 <?> "simple glyph instruction")
+    flags' <- flagsP numberOfPoints mempty <?> "flags"
+    xs <- Vector.foldM (coordinateP xFlagPair) mempty flags'
+    ys <- Vector.foldM (coordinateP yFlagPair) mempty flags'
+    pure $ SimpleGlyphDefinition
+        { endPtsOfContours = endPtsOfContours'
+        , instructions = instructions'
+        , coordinates = mkCoordinate <$> Vector.zip3 xs ys flags'
+        }
+  where
+    mkCoordinate (x, y, OutlineFlag{ onCurve }) = GlyphCoordinate x y onCurve
+    xFlagPair :: OutlineFlag -> (Bool, Bool)
+    xFlagPair OutlineFlag{ xShortVector, thisXIsSame } =
+        (xShortVector, thisXIsSame)
+    yFlagPair :: OutlineFlag -> (Bool, Bool)
+    yFlagPair OutlineFlag{ yShortVector, thisYIsSame } =
+        (yShortVector, thisYIsSame)
+    coordinateP
+        :: (OutlineFlag -> (Bool, Bool))
+        -> Vector Int16
+        -> OutlineFlag
+        -> Parser (Vector Int16)
+    coordinateP get accumulator first =
+        case get first of
+            (True, True) -> Vector.snoc accumulator . fromIntegral
+                <$> Megaparsec.Binary.word8
+                <?> "1 byte long positive coordinate"
+            (True, False)
+                -> Vector.snoc accumulator  . negate . fromIntegral
+                <$> Megaparsec.Binary.word8
+                <?> "1 byte long negative coordinate"
+            (False, False) -> Vector.snoc accumulator
+                <$> Megaparsec.Binary.int16be
+                <?> "2 bytes long coordinate"
+            (False, True) -> pure $ Vector.snoc accumulator 0
+    flagsP :: Int -> Vector OutlineFlag -> Parser (Vector OutlineFlag)
+    flagsP remaining accumulator
+        | remaining < 0 = pure accumulator
+        | otherwise = do
+            flag <- Megaparsec.Binary.word8 <?> "outline flags"
+            let flag' = OutlineFlag
+                    { onCurve = testBit flag 0
+                    , xShortVector = testBit flag 1
+                    , yShortVector = testBit flag 2
+                    , thisXIsSame = testBit flag 4
+                    , thisYIsSame = testBit flag 5
+                    }
+                repeat = testBit flag 3
+            repeatN <- 
+                if repeat
+                then (1 +)
+                    . fromIntegral
+                    <$> Megaparsec.Binary.word8
+                    <?> "flag repeat count"
+                else pure 1
+            flagsP (remaining - repeatN)
+                $ accumulator <> Vector.replicate repeatN flag'
+
+glyfTableP :: LocaTable -> Parser GlyfTable
+glyfTableP locaTable
+    | locaTable' <- unLocaTable locaTable
+    , not $ Vector.null locaTable' =
+        let locaInit = Vector.init locaTable'
+            offsets = traverse go
+                $ nubBy duplicate
+                $ sortOn fst
+                $ filter filterNullLength
+                $ Vector.toList
+                $ Vector.zip locaInit
+                $ Vector.tail locaTable'
+         in GlyfTable
+            . Vector.generate (Vector.length locaInit)
+            . generateTable locaInit
+            . IntMap.fromList
+            <$> offsets
+    | otherwise = pure $ GlyfTable mempty
+  where
+    filterNullLength (x, y) = x /= y
+    duplicate x y = fst x == fst y
+    generateTable :: Vector Word32 -> IntMap GlyphDescription -> Int -> GlyphDescription
+    generateTable locaInit offsetMap index =
+        offsetMap IntMap.! fromIntegral (locaInit Vector.! index)
+    go (locaOffset, nextOffset) = do
+        startOffset <- Megaparsec.getOffset
+        result <- glyphDescriptionP
+        endOffset <- Megaparsec.getOffset
+        flip Megaparsec.skipCount Megaparsec.Binary.word8
+            $ fromIntegral nextOffset
+            - fromIntegral locaOffset
+            - endOffset
+            + startOffset
+        pure (fromIntegral locaOffset, result)
+
+-- * Character to glyph mapping table
+
+cmapTableP :: Parser CmapTable
+cmapTableP = do
+    initialOffset <- Megaparsec.getOffset
+    version' <- Megaparsec.Binary.word16be
+    numberSubtables <- fromIntegral <$> Megaparsec.Binary.word16be
+    encodings' <- sortOn (getField @"offset")
+        <$> Megaparsec.count numberSubtables cmapHeaderP
+    parsedSubtables <- Megaparsec.some (subtableAtOffset initialOffset)
+    Megaparsec.eof
+    pure $ CmapTable
+        { version = version'
+        , encodings = encodings'
+        , subtables = IntMap.fromList parsedSubtables
+        }
+  where
+    subtableAtOffset initialOffset = do
+        currentOffset <- flip (-) initialOffset <$> Megaparsec.getOffset
+        parsedSubtable <- cmapFormatTableP
+        pure (currentOffset, parsedSubtable)
+
+cmapHeaderP :: Parser CmapEncoding
+cmapHeaderP = CmapEncoding
+    <$> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word32be
+
+cmapFormatTableP :: Parser CmapSubtable
+cmapFormatTableP = do
+    format' <- Megaparsec.Binary.word16be
+    case format' of
+        0 -> CmapFormat0 <$> cmapFormat0TableP
+        2 -> CmapFormat2 <$> cmapFormat2TableP
+        4 -> CmapFormat4 <$> cmapFormat4TableP
+        6 -> CmapFormat6 <$> cmapFormat6TableP
+        8 -> CmapFormat8 <$> cmapFormat8TableP
+        10 -> CmapFormat10 <$> cmapFormat10TableP
+        12 -> CmapFormat12 <$> cmapFormat12TableP
+        13 -> CmapFormat13 <$> cmapFormat13TableP
+        14 -> CmapFormat14 <$> cmapFormat14TableP
+        _ -> fail $ "Unsupported format " <> show format' <> "."
+
+cmapFormat14TableP :: Parser CmapFormat14Table
+cmapFormat14TableP = do
+    initialOffset <- (+ (-2)) <$> Megaparsec.getOffset
+    Megaparsec.Binary.word32be -- Length.
+    numVarSelectorRecords <- fromIntegral <$> Megaparsec.Binary.word32be
+    variationSelectorRecords' <- sortBy sortOffset . fold
+        <$> Megaparsec.count numVarSelectorRecords variationSelectorRecordP
+    let parseByOffset' = parseByOffset initialOffset
+    CmapFormat14Table <$> foldM parseByOffset' IntMap.empty variationSelectorRecords'
+  where
+    parseByOffset
+        :: Int
+        -> VariationSelectorMap
+        -> UVSOffset Word32 Word32
+        -> Parser VariationSelectorMap
+    parseByOffset _ accumulator uvsOffset'
+        | uvsOffset uvsOffset' == 0 = pure accumulator
+    parseByOffset tableOffset accumulator (DefaultUVSOffset varSelector' relativeOffset)
+        -- If the records at this offset were already parsed, look at any parsed
+        -- record and duplicate it updating the varSelector. The same logic
+        -- applies for the next pattern match, but for non-default UVS.
+        | Just member@(DefaultUVSOffset _ record :| _) <-
+            IntMap.lookup (fromIntegral relativeOffset) accumulator =
+
+            let newRecord = DefaultUVSOffset varSelector' record NonEmpty.<| member
+                relativeOffset' = fromIntegral relativeOffset
+             in pure $ IntMap.insert relativeOffset' newRecord accumulator
+        | otherwise = do
+            currentOffset <- Megaparsec.getOffset
+            let emptyBytes = tableOffset + fromIntegral relativeOffset - currentOffset
+                relativeOffset' = fromIntegral relativeOffset
+            Megaparsec.takeP Nothing emptyBytes
+            entryCount <- fromIntegral <$> Megaparsec.Binary.word32be
+            valueRanges <- vectorNP entryCount unicodeValueRangeP
+            pure $ IntMap.insert relativeOffset' (DefaultUVSOffset varSelector' valueRanges :| []) accumulator
+    parseByOffset tableOffset accumulator (NonDefaultUVSOffset varSelector' relativeOffset)
+        | Just member@(NonDefaultUVSOffset _ record :| _) <-
+            IntMap.lookup (fromIntegral relativeOffset) accumulator =
+
+            let newRecord = NonDefaultUVSOffset varSelector' record NonEmpty.<| member
+                relativeOffset' = fromIntegral relativeOffset
+             in pure $ IntMap.insert relativeOffset' newRecord accumulator
+        | otherwise = do
+            currentOffset <- Megaparsec.getOffset
+            let emptyBytes = tableOffset + fromIntegral relativeOffset - currentOffset
+            Megaparsec.takeP Nothing emptyBytes
+            entryCount <- fromIntegral <$> Megaparsec.Binary.word32be
+            flip (IntMap.insert $ fromIntegral relativeOffset) accumulator
+                . pure
+                . NonDefaultUVSOffset varSelector'
+                <$> vectorNP entryCount uvsMappingP
+    sortOffset x y = compare (uvsOffset x) (uvsOffset y)
+
+uvsOffset :: forall a. UVSOffset a a -> a
+uvsOffset (DefaultUVSOffset _ x) = x
+uvsOffset (NonDefaultUVSOffset _ x) = x
+
+variationSelectorRecordP :: Parser [UVSOffset Word32 Word32]
+variationSelectorRecordP = do
+    varSelector' <- word24P
+    defaultUVSOffset' <- Megaparsec.Binary.word32be
+    nonDefaultUVSOffset' <- Megaparsec.Binary.word32be
+
+    pure
+        [ DefaultUVSOffset varSelector' defaultUVSOffset'
+        , NonDefaultUVSOffset varSelector' nonDefaultUVSOffset'
+        ]
+
+uvsMappingP :: Parser UVSMapping
+uvsMappingP = UVSMapping
+    <$> word24P
+    <*> Megaparsec.Binary.word16be
+
+unicodeValueRangeP :: Parser UnicodeValueRange
+unicodeValueRangeP = UnicodeValueRange
+    <$> word24P
+    <*> Megaparsec.Binary.word8
+
+cmapFormat13TableP :: Parser CmapFormat13Table
+cmapFormat13TableP = cmapFormat12TableP
+
+cmapFormat12TableP :: Parser CmapFormat12Table
+cmapFormat12TableP = do
+    Megaparsec.takeP Nothing 6 -- Reserved and length.
+    language' <- Megaparsec.Binary.word32be
+    nGroups <- fromIntegral <$> Megaparsec.Binary.word32be
+    groups' <- vectorNP nGroups cmapGroupP
+
+    pure $ CmapFormat12Table
+        { language = language'
+        , groups = groups'
+        }
+
+cmapFormat10TableP :: Parser CmapFormat10Table
+cmapFormat10TableP = do
+    Megaparsec.takeP Nothing 2 -- Reserved.
+    length' <- fromIntegral <$> Megaparsec.Binary.word32be
+    language' <- Megaparsec.Binary.word32be
+    startCharCode' <- Megaparsec.Binary.word32be
+    numChars' <- Megaparsec.Binary.word32be
+    let remainingLength = div (length' - 24) 2
+    glyphs' <- vectorNP remainingLength Megaparsec.Binary.word16be
+
+    pure $ CmapFormat10Table
+        { language = language'
+        , startCharCode = startCharCode'
+        , numChars = numChars'
+        , glyphs = glyphs'
+        }
+
+cmapFormat8TableP :: Parser CmapFormat8Table
+cmapFormat8TableP = do
+    Megaparsec.takeP Nothing 6 -- Reserved and length.
+    language' <- Megaparsec.Binary.word32be
+    is32' <- Megaparsec.takeP Nothing 65536
+    nGroups <- fromIntegral <$> Megaparsec.Binary.word32be
+    groups' <- vectorNP nGroups cmapGroupP
+
+    pure $ CmapFormat8Table
+        { language = language'
+        , is32 = ByteString.unpack is32'
+        , groups = groups'
+        }
+
+cmapGroupP :: Parser CmapGroup
+cmapGroupP = CmapGroup
+    <$> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+
+cmapFormat6TableP :: Parser CmapFormat6Table
+cmapFormat6TableP = do
+    Megaparsec.Binary.word16be -- Length.
+    language' <- Megaparsec.Binary.word16be
+    firstCode' <- Megaparsec.Binary.word16be
+    entryCount' <- fromIntegral <$> Megaparsec.Binary.word16be
+    glyphIndexArray' <- vectorNP entryCount' Megaparsec.Binary.word16be
+
+    pure $ CmapFormat6Table
+        { language = language'
+        , firstCode = firstCode'
+        , glyphIndexArray = glyphIndexArray'
+        }
+
+cmapFormat4TableP :: Parser CmapFormat4Table
+cmapFormat4TableP = do
+    length' <- fromIntegral <$> Megaparsec.Binary.word16be
+    language' <- Megaparsec.Binary.word16be
+    segCount <- fromIntegral . (`div` 2) <$> Megaparsec.Binary.word16be
+    searchRange' <- Megaparsec.Binary.word16be
+    entrySelector' <- Megaparsec.Binary.word16be
+    rangeShift' <- Megaparsec.Binary.word16be
+    endCode' <- vectorNP segCount Megaparsec.Binary.word16be
+    rangeShift' <- Megaparsec.Binary.word16be
+    -- reservedPad 0.
+    startCode' <- vectorNP segCount Megaparsec.Binary.word16be
+    idDelta' <- vectorNP segCount Megaparsec.Binary.word16be
+    idRangeOffset' <- vectorNP segCount Megaparsec.Binary.word16be
+    let glyphIndexLength = div (length' - 16 - segCount * 8) 2
+    glyphIndexArray' <- vectorNP glyphIndexLength Megaparsec.Binary.word16be
+
+    pure $ CmapFormat4Table
+        { language = language'
+        , searchRange = searchRange'
+        , entrySelector = entrySelector'
+        , rangeShift = rangeShift'
+        , endCode = endCode'
+        , startCode = startCode'
+        , idDelta = idDelta'
+        , idRangeOffset = idRangeOffset'
+        , glyphIndexArray = glyphIndexArray'
+        }
+
+cmapFormat2TableP :: Parser CmapFormat2Table
+cmapFormat2TableP = do
+    length' <- fromIntegral <$> Megaparsec.Binary.word16be
+    language' <- Megaparsec.Binary.word16be
+    subHeaderKeys' <- vectorNP 256 Megaparsec.Binary.word16be
+    let maxIndex = succ $ fromIntegral $ Vector.maximum $ fmap (`div` 8) subHeaderKeys'
+    subHeaders' <- vectorNP maxIndex cmapFormat2SubheaderP
+    let glyphIndexLength = div (length' - 518 - maxIndex * 8) 2
+    glyphIndexArray' <- vectorNP glyphIndexLength Megaparsec.Binary.word16be
+
+    pure $ CmapFormat2Table
+        { language = language'
+        , subHeaderKeys = subHeaderKeys'
+        , subHeaders = subHeaders'
+        , glyphIndexArray = glyphIndexArray'
+        }
+
+cmapFormat2SubheaderP :: Parser CmapFormat2Subheader
+cmapFormat2SubheaderP = CmapFormat2Subheader
+    <$> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+
+cmapFormat0TableP :: Parser CmapFormat0Table
+cmapFormat0TableP = CmapFormat0Table
+    <$> Megaparsec.Binary.word16be
+    <* Megaparsec.Binary.word16be
+    <*> vectorNP 256 Megaparsec.Binary.word8
+
+-- * Generic parsing utilities
+
+word24P :: Parser Word32
+word24P = foldr unstep 0 . ByteString.unpack
+    <$> Megaparsec.takeP (Just "word24") 3
+  where
+    unstep b a = a `shiftL` 8 .|. fromIntegral b
+
+f2Dot14P :: Parser F2Dot14
+f2Dot14P = F2Dot14 <$> Megaparsec.Binary.int16be
+
+vectorP :: forall a. Parser a -> Parser (Vector a)
+vectorP = fmap Vector.fromList . Megaparsec.many
+
+vectorNP :: forall a. Int -> Parser a -> Parser (Vector a)
+vectorNP size = fmap Vector.fromList . Megaparsec.count size
+
+pascalStringP :: Parser ByteString
+pascalStringP = Megaparsec.Binary.word8
+    >>= fmap ByteString.pack
+    . flip Megaparsec.count Megaparsec.Binary.word8
+    . fromIntegral
+
+countP :: forall a. Int -> Parser a -> Parser (NonEmpty a)
+countP number parser
+    = (:|)
+    <$> parser
+    <*> Megaparsec.count (number - 1) parser
+
+longDateTimeP :: Parser LocalTime
+longDateTimeP = go <$> Megaparsec.Binary.int64be
+  where
+    go totalSeconds =
+        let (totalDays, secondsOfDay) = totalSeconds `divMod` (3600 * 24)
+            epoch = fromOrdinalDate 1904 1
+         in LocalTime
+            { localDay = addDays (fromIntegral totalDays) epoch
+            , localTimeOfDay = timeToTimeOfDay
+                $ secondsToDiffTime
+                $ fromIntegral secondsOfDay
+            }
+
+fixedP :: Parser Fixed32
+fixedP = Fixed32 . fromIntegral <$> Megaparsec.Binary.word32be
+
+parseTable
+    :: TableDirectory
+    -> Parser a
+    -> Megaparsec.State ByteString Void
+    -> Either (Megaparsec.ParseErrorBundle ByteString Void) a
+parseTable TableDirectory{ offset, length } parser state = snd
+    $ Megaparsec.runParser' parser 
+    $ state
+        { Megaparsec.stateInput = stateInput
+        , Megaparsec.stateOffset = stateOffset
+        , Megaparsec.statePosState = posState
+            { Megaparsec.pstateInput = stateInput
+            , Megaparsec.pstateOffset = stateOffset
+            }
+        }
+  where
+    posState = Megaparsec.statePosState state
+    stateInput = ByteString.take length
+        $ ByteString.drop (offset - Megaparsec.stateOffset state)
+        $ Megaparsec.stateInput state
+    stateOffset = offset
+
+-- * OS/2 table
+
+os2TableP :: Parser Os2Table
+os2TableP = do
+    baseFields <- os2BaseFieldsP
+    result <- case getField @"version" baseFields of
+        0 -> Os2Version0 baseFields
+            <$> Megaparsec.optional os2MicrosoftFieldsP
+        1 -> Os2Version1 baseFields
+            <$> os2MicrosoftFieldsP
+            <*> os2Version1FieldsP
+        2 -> Os2Version2 baseFields
+            <$> os2MicrosoftFieldsP
+            <*> os2Version4FieldsP
+        3 -> Os2Version3 baseFields
+            <$> os2MicrosoftFieldsP
+            <*> os2Version4FieldsP
+        4 -> Os2Version4 baseFields
+            <$> os2MicrosoftFieldsP
+            <*> os2Version4FieldsP
+        5 -> Os2Version5 baseFields
+            <$> os2MicrosoftFieldsP
+            <*> os2Version5FieldsP
+        unsupportedVersion -> fail
+            $ "Unsupported OS/2 version: " <> show unsupportedVersion
+    Megaparsec.eof
+    pure result
+
+os2BaseFieldsP :: Parser Os2BaseFields
+os2BaseFieldsP = Os2BaseFields
+    <$> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> panoseP
+    <*> vectorNP 4 Megaparsec.Binary.word32be
+    <*> vectorNP 4 Megaparsec.Binary.int8
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+
+os2MicrosoftFieldsP :: Parser Os2MicrosoftFields
+os2MicrosoftFieldsP = Os2MicrosoftFields
+    <$> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+
+os2Version1FieldsP :: Parser Os2Version1Fields
+os2Version1FieldsP = Os2Version1Fields
+    <$> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+
+os2Version4FieldsP :: Parser Os2Version4Fields
+os2Version4FieldsP = Os2Version4Fields
+    <$> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+
+os2Version5FieldsP :: Parser Os2Version5Fields
+os2Version5FieldsP = Os2Version5Fields
+    <$> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.word32be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.int16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.word16be
+
+panoseP :: Parser Panose
+panoseP = Panose
+    <$> bFamilyTypeP
+    <*> bSerifStyleP
+    <*> bWeightP
+    <*> bProportionP
+    <*> bContrastP
+    <*> bStrokeVariationP
+    <*> bArmStyleP
+    <*> bLetterformP
+    <*> bMidlineP
+    <*> bXHeightP
+
+bFamilyTypeP :: Parser BFamilyType
+bFamilyTypeP
+    = (Megaparsec.single 0 $> AnyFamilyType)
+    <|> (Megaparsec.single 1 $> NoFitFamilyType)
+    <|> (Megaparsec.single 2 $> TextAndDisplayFamilyType)
+    <|> (Megaparsec.single 3 $> ScriptFamilyType)
+    <|> (Megaparsec.single 4 $> DecorativeFamilyType)
+    <|> (Megaparsec.single 5 $> PictorialFamilyType)
+    <?> "bFamilyType"
+
+bSerifStyleP :: Parser BSerifStyle
+bSerifStyleP
+    = (Megaparsec.single 0 $> AnySerifStyle)
+    <|> (Megaparsec.single 1 $> NoFitSerifStyle)
+    <|> (Megaparsec.single 2 $> CoveSerifStyle)
+    <|> (Megaparsec.single 3 $> ObtuseCoveSerifStyle)
+    <|> (Megaparsec.single 4 $> SquareCoveSerifStyle)
+    <|> (Megaparsec.single 5 $> ObtuseSquareCoveSerifStyle)
+    <|> (Megaparsec.single 6 $> SquareSerifStyle)
+    <|> (Megaparsec.single 7 $> ThinSerifStyle)
+    <|> (Megaparsec.single 8 $> BoneSerifStyle)
+    <|> (Megaparsec.single 9 $> ExaggeratedSerifStyle)
+    <|> (Megaparsec.single 10 $> TriangleSerifStyle)
+    <|> (Megaparsec.single 11 $> NormalSansSerifStyle)
+    <|> (Megaparsec.single 12 $> ObtuseSansSerifStyle)
+    <|> (Megaparsec.single 13 $> PerpSansSerifStyle)
+    <|> (Megaparsec.single 14 $> FlaredSerifStyle)
+    <|> (Megaparsec.single 15 $> RoundedSerifStyle)
+    <?> "bSerifStyle"
+
+bWeightP :: Parser BWeight
+bWeightP
+    = (Megaparsec.single 0 $> AnyWeight)
+    <|> (Megaparsec.single 1 $> NoFitWeight)
+    <|> (Megaparsec.single 2 $> VeryLightWeight)
+    <|> (Megaparsec.single 3 $> LightWeight)
+    <|> (Megaparsec.single 4 $> ThinWeight)
+    <|> (Megaparsec.single 5 $> BookWeight)
+    <|> (Megaparsec.single 6 $> MediumWeight)
+    <|> (Megaparsec.single 7 $> DemiWeight)
+    <|> (Megaparsec.single 8 $> BoldWeight)
+    <|> (Megaparsec.single 9 $> HeavyWeight)
+    <|> (Megaparsec.single 10 $> BlackWeight)
+    <|> (Megaparsec.single 11 $> NordWeight)
+    <?> "bWeight"
+
+bProportionP :: Parser BProportion
+bProportionP
+    = (Megaparsec.single 0 $> AnyProportion)
+    <|> (Megaparsec.single 1 $> NoFitProportion)
+    <|> (Megaparsec.single 2 $> OldStyleProportion)
+    <|> (Megaparsec.single 3 $> ModernProportion)
+    <|> (Megaparsec.single 4 $> EvenWidthProportion)
+    <|> (Megaparsec.single 5 $> ExpandedProportion)
+    <|> (Megaparsec.single 6 $> CondensedProportion)
+    <|> (Megaparsec.single 7 $> VeryExpandedProportion)
+    <|> (Megaparsec.single 8 $> VeryCondensedProportion)
+    <|> (Megaparsec.single 9 $> MonospacedProportion)
+    <?> "bProportion"
+
+bContrastP :: Parser BContrast
+bContrastP
+    = (Megaparsec.single 0 $> AnyContrast)
+    <|> (Megaparsec.single 1 $> NoFitContrast)
+    <|> (Megaparsec.single 2 $> NoneContrast)
+    <|> (Megaparsec.single 3 $> VeryLowContrast)
+    <|> (Megaparsec.single 4 $> LowContrast)
+    <|> (Megaparsec.single 5 $> MediumLowContrast)
+    <|> (Megaparsec.single 6 $> MediumContrast)
+    <|> (Megaparsec.single 7 $> MediumHighContrast)
+    <|> (Megaparsec.single 8 $> HighContrast)
+    <|> (Megaparsec.single 9 $> VeryHighContrast)
+    <?> "bContrast"
+
+bStrokeVariationP :: Parser BStrokeVariation
+bStrokeVariationP
+    = (Megaparsec.single 0 $> AnyStrokeVariatoon)
+    <|> (Megaparsec.single 1 $> NoFitStrokeVariatoon)
+    <|> (Megaparsec.single 2 $> GradualDiagonalStrokeVariatoon)
+    <|> (Megaparsec.single 3 $> GradualTransitionalStrokeVariatoon)
+    <|> (Megaparsec.single 4 $> GradualVerticalStrokeVariatoon)
+    <|> (Megaparsec.single 5 $> GradualHorizontalStrokeVariatoon)
+    <|> (Megaparsec.single 6 $> RapidVerticalStrokeVariatoon)
+    <|> (Megaparsec.single 7 $> RapidHorizontalStrokeVariatoon)
+    <|> (Megaparsec.single 8 $> InstantVerticalStrokeVariatoon)
+    <?> "bStrokeVariation"
+
+bArmStyleP :: Parser BArmStyle
+bArmStyleP
+    = (Megaparsec.single 0 $> AnyArmStyle)
+    <|> (Megaparsec.single 1 $> NoFitArmStyle)
+    <|> (Megaparsec.single 2 $> StraightArmsHorizontalArmStyle)
+    <|> (Megaparsec.single 3 $> StraightArmsWedgeArmStyle)
+    <|> (Megaparsec.single 4 $> StraightArmsVerticalArmStyle)
+    <|> (Megaparsec.single 5 $> StraightArmsSingleSerifArmStyle)
+    <|> (Megaparsec.single 6 $> StraightArmsDoubleSerifArmStyle)
+    <|> (Megaparsec.single 7 $> NonStraightArmsHorizontalArmStyle)
+    <|> (Megaparsec.single 8 $> NonStraightArmsWedgeArmStyle)
+    <|> (Megaparsec.single 9 $> NonStraightArmsVerticalArmStyle)
+    <|> (Megaparsec.single 10 $> NonStraightArmsSingleSerifArmStyle)
+    <|> (Megaparsec.single 11 $> NonStraightArmsDoubleSerifArmStyle)
+    <?> "bArmStyle"
+
+bLetterformP :: Parser BLetterform
+bLetterformP
+    = (Megaparsec.single 0 $> AnyLetterform)
+    <|> (Megaparsec.single 1 $> NoFitLetterform)
+    <|> (Megaparsec.single 2 $> NormalContactLetterform)
+    <|> (Megaparsec.single 3 $> NormalWeightedLetterform)
+    <|> (Megaparsec.single 4 $> NormalBoxedLetterform)
+    <|> (Megaparsec.single 5 $> NormalFlattenedLetterform)
+    <|> (Megaparsec.single 6 $> NormalRoundedLetterform)
+    <|> (Megaparsec.single 7 $> NormalOffCenterLetterform)
+    <|> (Megaparsec.single 8 $> NormalSquareLetterform)
+    <|> (Megaparsec.single 9 $> ObliqueContactLetterform)
+    <|> (Megaparsec.single 10 $> ObliqueWeightedLetterform)
+    <|> (Megaparsec.single 11 $> ObliqueBoxedLetterform)
+    <|> (Megaparsec.single 12 $> ObliqueFlattenedLetterform)
+    <|> (Megaparsec.single 13 $> ObliqueRoundedLetterform)
+    <|> (Megaparsec.single 14 $> ObliqueOffCenterLetterform)
+    <|> (Megaparsec.single 15 $> ObliqueSquareLetterform)
+    <?> "bLetterform"
+
+bXHeightP :: Parser BXHeight
+bXHeightP
+    = (Megaparsec.single 0 $> AnyXHeight)
+    <|> (Megaparsec.single 1 $> NoFitXHeight)
+    <|> (Megaparsec.single 2 $>  ConstantSmallXHeight)
+    <|> (Megaparsec.single 3 $>  ConstantStandardXHeight)
+    <|> (Megaparsec.single 4 $>  ConstantLargeXHeight)
+    <|> (Megaparsec.single 5 $>  DuckingSmallXHeight)
+    <|> (Megaparsec.single 6 $>  DuckingStandardXHeight)
+    <|> (Megaparsec.single 7 $>  DuckingLargeXHeight)
+    <?> "bXHeight"
+
+bMidlineP :: Parser BMidline
+bMidlineP
+    = (Megaparsec.single 0 $> AnyMidline)
+    <|> (Megaparsec.single 1 $> NoFitMidline)
+    <|> (Megaparsec.single 2 $> StandardTrimmedMidline)
+    <|> (Megaparsec.single 3 $> StandardPointedMidline)
+    <|> (Megaparsec.single 4 $> StandardSerifedMidline)
+    <|> (Megaparsec.single 5 $> HighTrimmedMidline)
+    <|> (Megaparsec.single 6 $> HighPointedMidline)
+    <|> (Megaparsec.single 7 $> HighSerifedMidline)
+    <|> (Megaparsec.single 8 $> ConstantTrimmedMidline)
+    <|> (Megaparsec.single 9 $> ConstantPointedMidline)
+    <|> (Megaparsec.single 10 $> ConstantSerifedMidline)
+    <|> (Megaparsec.single 11 $> LowTrimmedMidline)
+    <|> (Megaparsec.single 12 $> LowPointedMidline)
+    <|> (Megaparsec.single 13 $> LowSerifedMidline)
+    <?> "bMidline"
diff --git a/src/Graphics/Fountainhead/TrueType.hs b/src/Graphics/Fountainhead/TrueType.hs
new file mode 100644
index 0000000..2b70841
--- /dev/null
+++ b/src/Graphics/Fountainhead/TrueType.hs
@@ -0,0 +1,794 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+-- | Types representing a TrueType font.
+module Graphics.Fountainhead.TrueType
+    ( BArmStyle(..)
+    , BContrast(..)
+    , BFamilyType(..)
+    , BLetterform(..)
+    , BMidline(..)
+    , BProportion(..)
+    , BSerifStyle(..)
+    , BStrokeVariation(..)
+    , BWeight(..)
+    , BXHeight(..)
+    , CVTable(..)
+    , CmapSubtable(..)
+    , CmapTable(..)
+    , CmapEncoding(..)
+    , CmapFormat0Table(..)
+    , CmapFormat2Subheader(..)
+    , CmapFormat2Table(..)
+    , CmapFormat4Table(..)
+    , CmapFormat6Table(..)
+    , CmapGroup(..)
+    , CmapFormat8Table(..)
+    , CmapFormat10Table(..)
+    , CmapFormat12Table(..)
+    , CmapFormat13Table
+    , CmapFormat14Table(..)
+    , ComponentGlyphFlags(..)
+    , ComponentGlyphPartDescription(..)
+    , CompoundGlyphDefinition(..)
+    , DeviceRecord(..)
+    , FpgmTable(..)
+    , FontDirectionHint(..)
+    , FontDirectory(..)
+    , FontStyle(..)
+    , GlyfTable(..)
+    , GlyphArgument(..)
+    , GlyphCoordinate(..)
+    , GlyphDefinition(..)
+    , GlyphDescription(..)
+    , GlyphTransformationOption(..)
+    , HdmxTable(..)
+    , HeadTable(..)
+    , HheaTable(..)
+    , HmtxTable(..)
+    , LocaTable(..)
+    , LongHorMetric(..)
+    , MaxpTable(..)
+    , NameRecord(..)
+    , NameTable(..)
+    , OffsetSubtable(..)
+    , OpenMaxpTable(..)
+    , Os2BaseFields(..)
+    , Os2MicrosoftFields(..)
+    , Os2Table(..)
+    , Os2Version1Fields(..)
+    , Os2Version4Fields(..)
+    , Os2Version5Fields(..)
+    , OutlineFlag(..)
+    , Panose(..)
+    , PostFormat2Table(..)
+    , PostHeader(..)
+    , PostSubtable(..)
+    , PostTable(..)
+    , PrepTable(..)
+    , SimpleGlyphDefinition(..)
+    , TableDirectory(..)
+    , TrueMaxpTable(..)
+    , UVSOffset(..)
+    , UVSMapping(..)
+    , UnicodeValueRange(..)
+    , VariationSelectorMap
+    , unLocaTable
+    ) where
+
+import Data.ByteString (ByteString)
+import Data.Int (Int8, Int16)
+import Data.IntMap (IntMap)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Time (LocalTime(..))
+import Data.Vector (Vector)
+import Data.Word (Word8, Word16, Word32)
+import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..))
+
+-- * Font directory
+
+data FontDirectory = FontDirectory
+    { offsetSubtable :: OffsetSubtable
+    , tableDirectory :: [TableDirectory]
+    } deriving (Eq, Show)
+
+data OffsetSubtable = OffsetSubtable
+    { scalerType :: Word32
+    , numTables :: Int
+    , searchRange :: Word16
+    , entrySelector :: Word16
+    , rangeShift :: Word16
+    } deriving (Eq, Show)
+
+data TableDirectory = TableDirectory
+    { tag :: ByteString
+    , checkSum :: Word32
+    , offset :: Int
+    , length :: Int
+    } deriving (Eq, Show)
+
+-- * Name table
+
+data NameTable = NameTable
+    { format :: Word16 -- ^ Format selector. Set to 0.
+    , nameRecord :: [NameRecord] -- ^ The name records array.
+    , variable :: [ByteString] -- ^ The character strings of the names.
+    } deriving (Eq, Show)
+
+data NameRecord = NameRecord
+    { platformID :: Word16 -- ^ Platform identifier code.
+    , platformSpecificID :: Word16 -- ^ Platform-specific encoding identifier.
+    , languageID :: Word16 -- ^  Language identifier.
+    , nameID :: Word16 -- ^ Name identifier.
+    , length :: Int -- ^ Name string length in bytes.
+    , offset :: Int -- ^ Offset.
+    } deriving (Eq, Show)
+
+-- * 'cvt ' table
+
+newtype CVTable = CVTable [Int16]
+    deriving (Eq, Show)
+
+-- * Maximum profile table
+
+data TrueMaxpTable = TrueMaxpTable
+    { version :: Fixed32 -- ^ 0x00010000 (1.0).
+    , numGlyphs :: Word16 -- ^ The number of glyphs in the font.
+    , maxPoints :: Word16 -- ^ Points in non-compound glyph.
+    , maxContours :: Word16 -- ^ Contours in non-compound glyph.
+    , maxComponentPoints :: Word16 -- ^ Points in compound glyph.
+    , maxComponentContours :: Word16 -- ^ Contours in compound glyph.
+    , maxZones :: Word16 -- ^ Set to 2.
+    , maxTwilightPoints :: Word16 -- ^ Points used in Twilight Zone (Z0).
+    , maxStorage :: Word16 -- ^ Number of Storage Area locations.
+    , maxFunctionDefs :: Word16 -- ^ Number of FDEFs.
+    , maxInstructionDefs :: Word16 -- ^ Number of IDEFs.
+    , maxStackElements :: Word16 -- ^ Maximum stack depth.
+    , maxSizeOfInstructions :: Word16 -- ^ Byte count for glyph instructions.
+    , maxComponentElements :: Word16 -- ^ Number of glyphs referenced at top level.
+    , maxComponentDepth :: Word16 -- ^ Levels of recursion, set to 0 if font has only simple glyphs.
+    } deriving (Eq, Show)
+
+data OpenMaxpTable = OpenMaxpTable
+    { version :: Fixed32 -- ^ 0x00005000 (0.5).
+    , numGlyphs :: Word16 -- ^ The number of glyphs in the font.
+    } deriving (Eq, Show)
+
+data MaxpTable = OpenMaxp OpenMaxpTable | TrueMaxp TrueMaxpTable
+    deriving (Eq, Show)
+
+-- * Horizontal header table
+
+data HheaTable = HheaTable
+    { version :: Fixed32 -- ^ 0x00010000 (1.0).
+    , ascent :: Int16 -- ^ Distance from baseline of highest ascender.
+    , descent :: Int16 -- ^ Distance from baseline of lowest descender.
+    , lineGap :: Int16 -- ^ Typographic line gap.
+    , advanceWidthMax :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , minLeftSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , minRightSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , xMaxExtent :: Word16 -- ^ max(lsb + (xMax-xMin)).
+    , caretSlopeRise :: Int16 -- ^ used to calculate the slope of the caret (rise/run) set to 1 for vertical caret.
+    , caretSlopeRun :: Int16 -- ^ 0 for vertical.
+    , caretOffset :: Int16 -- ^ Set value to 0 for non-slanted fonts.
+    , metricDataFormat :: Int16 -- ^ 0 for current format.
+    , numOfLongHorMetrics :: Word16 -- ^ Number of advance widths in metrics table.
+    } deriving (Eq, Show)
+
+-- * Font header table
+
+data HeadTable = HeadTable
+    { version :: Fixed32 -- ^ 0x00010000 if (version 1.0).
+    , fontRevision :: Fixed32 -- ^ Set by font manufacturer.
+    , checkSumAdjustment :: Word32 -- ^ To compute: set it to 0, calculate the checksum for the 'head' table and put it in the table directory, sum the entire font as a uint32_t, then store 0xB1B0AFBA - sum. (The checksum for the 'head' table will be wrong as a result. That is OK; do not reset it.)
+    , magicNumber :: Word32 -- ^ Set to 0x5F0F3CF5.
+    , flags :: Word16
+    , unitsPerEm :: Word16 -- ^ Range from 64 to 16384.
+    , created :: LocalTime -- ^ International date.
+    , modified :: LocalTime -- ^ International date.
+    , xMin :: Int16 -- ^ For all glyph bounding boxes.
+    , yMin :: Int16 -- ^ For all glyph bounding boxes.
+    , xMax :: Int16 -- ^ For all glyph bounding boxes.
+    , yMax :: Int16 -- ^ For all glyph bounding boxes.
+    , macStyle :: FontStyle
+    , lowestRecPPEM :: Word16 -- ^ Smallest readable size in pixels.
+    , fontDirectionHint :: FontDirectionHint -- ^ 0 Mixed directional glyphs.
+    , indexToLocFormat :: Word16 -- ^ 0 for short offsets, 1 for long.
+    , glyphDataFormat :: Word16 -- ^ 0 for current format.
+    } deriving (Eq, Show)
+
+data FontStyle = FontStyle
+    { bold :: Bool
+    , italic :: Bool
+    , underline :: Bool
+    , outline :: Bool
+    , shadow :: Bool
+    , condensed :: Bool
+    , extended :: Bool
+    } deriving (Eq, Show)
+
+data FontDirectionHint
+    = MixedDirectionalGlyphs -- ^ 0. Mixed directional glyphs.
+    | StronglyLeftToRightGlyphs -- ^ 1. Only strongly left to right glyphs.
+    | LeftToRightGlyphsWithNeutrals -- ^ 2. Like 1 but also contains neutrals.
+    | StronglyRightToLeftGlyphs -- ^ -1. Only strongly right to left glyphs.
+    | RightToLeftGlyphsWithNeutrals -- ^ -2. Like -1 but also contains neutrals.
+    deriving (Eq, Show)
+
+data LocaTable
+    = ShortLocaTable (Vector Word16)
+    | LongLocaTable (Vector Word32)
+    deriving (Eq, Show)
+
+unLocaTable :: LocaTable -> Vector Word32
+unLocaTable (LongLocaTable values) = values
+unLocaTable (ShortLocaTable values) = (* 2) . fromIntegral <$> values
+
+-- * Horizontal metrics table
+
+data LongHorMetric = LongHorMetric
+    { advanceWidth :: Word16
+    , leftSideBearing :: Int16
+    } deriving (Eq, Show)
+
+data HmtxTable = HmtxTable
+    { hMetrics :: NonEmpty LongHorMetric
+    , leftSideBearing :: [Int16]
+    } deriving (Eq, Show)
+
+-- * Glyph name and PostScript font table
+
+data PostHeader = PostHeader
+    { format :: Fixed32 -- ^ Format of this table
+    , italicAngle :: Fixed32 -- ^ Italic angle in degrees
+    , underlinePosition :: Int16 -- ^ Underline position
+    , underlineThickness :: Int16 -- ^ Underline thickness
+    , isFixedPitch :: Word32 -- ^ Font is monospaced; set to 1 if the font is monospaced and 0 otherwise (N.B., to maintain compatibility with older versions of the TrueType spec, accept any non-zero value as meaning that the font is monospaced)
+    , minMemType42 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 42 font
+    , maxMemType42 :: Word32 -- ^ Maximum memory usage when a TrueType font is downloaded as a Type 42 font
+    , minMemType1 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 1 font
+    , maxMemType1 :: Word32 -- ^ Maximum memory usage when a TrueType font is downloaded as a Type 1 font
+    } deriving (Eq, Show)
+
+data PostFormat2Table = PostFormat2Table
+    { glyphNameIndex :: Vector Word16 -- ^ Ordinal number of this glyph in 'post' string tables. This is not an offset.
+    , names :: Vector ByteString
+    } deriving (Eq, Show)
+
+data PostSubtable
+    = None
+    | PostFormat2 PostFormat2Table
+    | PostFormat25 (Vector Int8)
+    | PostFormat4 (Vector Word16)
+    deriving (Eq, Show)
+
+data PostTable = PostTable
+    { postHeader :: PostHeader
+    , postSubtable :: PostSubtable
+    } deriving (Eq, Show)
+
+-- * Font program table
+
+newtype FpgmTable = FpgmTable (Vector Word8)
+    deriving (Eq, Show)
+
+-- * Prep table
+
+newtype PrepTable = PrepTable (Vector Word8)
+    deriving (Eq, Show)
+
+-- * Horizontal device metrics table
+
+data HdmxTable = HdmxTable
+    { format :: Int16 -- ^ Format version number.
+    , records :: [DeviceRecord]
+    } deriving (Eq, Show)
+
+data DeviceRecord = DeviceRecord
+    { pixelSize :: Word8 -- ^ Pixel size for following widths.
+    , maximumWidth :: Word8 -- ^ Maximum width.
+    , widths :: Vector Word8 -- ^ Widths.
+    } deriving (Eq, Show)
+
+-- * Glyph outline table
+
+data GlyphDescription = GlyphDescription
+    { numberOfContours :: Int
+    , xMin :: Int16 -- ^ Minimum x for coordinate data.
+    , yMin :: Int16 -- ^ Minimum y for coordinate data.
+    , xMax :: Int16 -- ^ Maximum x for coordinate data.
+    , yMax :: Int16 -- ^ Maximum y for coordinate data.
+    , definition :: GlyphDefinition
+    } deriving (Eq, Show)
+
+data GlyphArgument
+    = GlyphInt16Argument Int16
+    | GlyphWord16Argument Word16
+    | GlyphInt8Argument Int8
+    | GlyphWord8Argument Word8
+    deriving (Eq, Show)
+
+data GlyphTransformationOption
+    = GlyphNoScale
+    | GlyphScale F2Dot14
+    | GlyphXyScale F2Dot14 F2Dot14
+    | Glyph2By2Scale F2Dot14 F2Dot14 F2Dot14 F2Dot14
+    deriving (Eq, Show)
+
+data SimpleGlyphDefinition = SimpleGlyphDefinition
+    -- | Array of last points of each contour; n is the number of contours;
+    -- array entries are point indices.
+    { endPtsOfContours :: Vector Word16
+    -- | Array of instructions for this glyph.
+    , instructions :: Vector Word8
+    -- | Array of coordinates; the first is relative to (0,0), others are
+    -- relative to previous point.
+    , coordinates :: Vector GlyphCoordinate
+    } deriving (Eq, Show)
+
+data CompoundGlyphDefinition = CompoundGlyphDefinition
+    { components :: Vector ComponentGlyphPartDescription
+    , instructions :: Vector Word8
+    } deriving (Eq, Show)
+
+data GlyphDefinition
+    = SimpleGlyph SimpleGlyphDefinition
+    | CompoundGlyph CompoundGlyphDefinition
+    deriving (Eq, Show)
+
+data ComponentGlyphFlags = ComponentGlyphFlags
+    { roundXyToGrid :: Bool
+    , weHaveInstructions :: Bool
+    , useMyMetrics :: Bool
+    , overlapCompound :: Bool
+    } deriving (Eq, Show)
+
+data GlyphCoordinate = GlyphCoordinate
+    { coordinateX :: Int16
+    , coordinateY :: Int16
+    , onCurve :: Bool
+    } deriving (Eq, Show)
+
+data ComponentGlyphPartDescription = ComponentGlyphPartDescription
+    { flags :: ComponentGlyphFlags
+    , glyphIndex :: Word16
+    , argument1 :: GlyphArgument
+    , argument2 :: GlyphArgument
+    , transformationOption :: GlyphTransformationOption
+    } deriving (Eq, Show)
+
+-- * Glyph outline table
+
+data OutlineFlag = OutlineFlag
+    { onCurve :: Bool
+    , xShortVector :: Bool
+    , yShortVector :: Bool
+    , thisXIsSame :: Bool
+    , thisYIsSame :: Bool
+    } deriving (Eq, Show)
+
+newtype GlyfTable = GlyfTable (Vector GlyphDescription)
+    deriving (Eq, Show)
+
+-- * Character to glyph mapping table
+
+data CmapTable = CmapTable
+    { version :: Word16 -- ^ Version number is zero.
+    -- | Encodings with an offset into subtables map.
+    , encodings :: [CmapEncoding]
+    -- ^ The key into the map is the offset in the 'CmapEncoding's.
+    , subtables :: IntMap CmapSubtable
+    } deriving (Eq, Show)
+
+data CmapEncoding = CmapEncoding
+    { platformID :: Word16 -- ^ Platform identifier
+    , platformSpecificID :: Word16 -- ^ Platform-specific encoding identifier.
+    , offset :: Word32 -- ^ Offst of the mapping table.
+    } deriving (Eq, Show)
+
+data CmapFormat0Table = CmapFormat0Table
+    { language :: Word16 -- ^ Language code.
+    , glyphIndexArray :: Vector Word8 -- ^ An array that maps character codes to glyph index values.
+    } deriving (Eq, Show)
+
+data CmapFormat2Subheader = CmapFormat2Subheader
+    { firstCode :: Word16
+    , entryCount :: Word16
+    , idDelta :: Int16
+    , idRangeOffset :: Word16
+    } deriving (Eq, Show)
+
+data CmapFormat2Table = CmapFormat2Table
+    { language :: Word16 -- ^ Language code.
+    , subHeaderKeys :: Vector Word16 -- ^ Array that maps high bytes to subHeaders: value is index * 8.
+    , subHeaders :: Vector CmapFormat2Subheader -- ^ Variable length array of subHeader structures.
+    , glyphIndexArray :: Vector Word16 -- ^ Variable length array containing subarrays.
+    } deriving (Eq, Show)
+
+data CmapFormat4Table = CmapFormat4Table
+    { language :: Word16 -- ^ Language code.
+    , searchRange :: Word16 -- ^ 2 * (2**FLOOR(log2(segCount))).
+    , entrySelector :: Word16 -- ^ log2(searchRange/2).
+    , rangeShift :: Word16 -- ^ (2 * segCount) - searchRange.
+    , endCode :: Vector Word16 -- ^ Ending character code for each segment, last = 0xFFFF.
+    , startCode :: Vector Word16 -- ^ Starting character code for each segment.
+    , idDelta :: Vector Word16 -- ^ Delta for all character codes in segment.
+    , idRangeOffset :: Vector Word16 -- ^ Offset in bytes to glyph indexArray, or 0.
+    , glyphIndexArray :: Vector Word16 -- ^ Glyph index array.
+    } deriving (Eq, Show)
+
+data CmapFormat6Table = CmapFormat6Table
+    { language :: Word16 -- ^ Language code.
+    , firstCode :: Word16 -- ^ First character code of subrange.
+    , glyphIndexArray :: Vector Word16 -- ^ Array of glyph index values for character codes in the range
+    } deriving (Eq, Show)
+
+data CmapGroup = CmapGroup
+    -- | First character code in this group; note that if this group is for one
+    -- or more 16-bit character codes (which is determined from the is32 array),
+    -- this 32-bit value will have the high 16-bits set to zero.
+    { startCharCode :: Word32
+    -- | Last character code in this group; same condition as listed above for
+    -- the startCharCode.
+    , endCharCode :: Word32
+    -- | Glyph index corresponding to the starting character code.
+    , startGlyphCode :: Word32
+    } deriving (Eq, Show)
+
+data CmapFormat8Table = CmapFormat8Table
+    { language :: Word32 -- ^ Language code.
+    -- | Tightly packed array of bits (8K bytes total) indicating whether the
+    -- particular 16-bit (index) value is the start of a 32-bit character code.
+    , is32 :: [Word8]
+    -- | Word32 Number of groupings which follow.
+    , groups :: Vector CmapGroup
+    } deriving (Eq, Show)
+
+data CmapFormat10Table = CmapFormat10Table
+    { language :: Word32 -- ^ Language code.
+    , startCharCode :: Word32 -- ^ First character code covered.
+    , numChars :: Word32 -- ^ Number of character codes covered.
+    , glyphs :: Vector Word16 -- ^ Array of glyph indices for the character codes covered.
+    } deriving (Eq, Show)
+
+data CmapFormat12Table = CmapFormat12Table
+    { language :: Word32 -- ^ Language code.
+    , groups :: Vector CmapGroup
+    } deriving (Eq, Show)
+
+type CmapFormat13Table = CmapFormat12Table
+
+newtype CmapFormat14Table = CmapFormat14Table
+    { varSelectorRecords :: VariationSelectorMap
+    } deriving (Eq, Show)
+
+data CmapSubtable
+    = CmapFormat0 CmapFormat0Table
+    | CmapFormat2 CmapFormat2Table
+    | CmapFormat4 CmapFormat4Table
+    | CmapFormat6 CmapFormat6Table
+    | CmapFormat8 CmapFormat8Table
+    | CmapFormat10 CmapFormat10Table
+    | CmapFormat12 CmapFormat12Table
+    | CmapFormat13 CmapFormat13Table
+    | CmapFormat14 CmapFormat14Table
+    deriving (Eq, Show)
+
+data UVSOffset a b = DefaultUVSOffset Word32 a | NonDefaultUVSOffset Word32 b
+    deriving (Eq, Show)
+
+data UVSMapping = UVSMapping
+    { unicodeValue :: Word32 -- ^ Base Unicode value of the UVS.
+    , glyphID :: Word16 -- ^ Glyph ID of the UVS.
+    } deriving (Eq, Show)
+
+data UnicodeValueRange = UnicodeValueRange
+    { startUnicodeValue :: Word32 -- ^ First value in this range.
+    , additionalCount :: Word8 -- ^ Number of additional values in this range.
+    } deriving (Eq, Show)
+
+-- | Mapping from variation selector record offsets to the record data.
+type VariationSelectorMap = IntMap
+    (NonEmpty (UVSOffset (Vector UnicodeValueRange) (Vector UVSMapping)))
+
+-- * OS/2 table
+
+data Os2Table
+    = Os2Version0 Os2BaseFields (Maybe Os2MicrosoftFields)
+    | Os2Version1 Os2BaseFields Os2MicrosoftFields Os2Version1Fields
+    | Os2Version2 Os2BaseFields Os2MicrosoftFields Os2Version4Fields
+    | Os2Version3 Os2BaseFields Os2MicrosoftFields Os2Version4Fields
+    | Os2Version4 Os2BaseFields Os2MicrosoftFields Os2Version4Fields
+    | Os2Version5 Os2BaseFields Os2MicrosoftFields Os2Version5Fields
+    deriving (Eq, Show)
+
+data Os2Version1Fields = Os2Version1Fields
+    { ulCodePageRange1 :: Word32
+    , ulCodePageRange2 :: Word32
+    } deriving (Eq, Show)
+
+data Os2MicrosoftFields = Os2MicrosoftFields
+    { sTypoAscender :: Int16
+    , sTypoDescender :: Int16
+    , sTypoLineGap :: Int16
+    , usWinAscent :: Word16
+    , usWinDescent :: Word16
+    } deriving (Eq, Show)
+
+data Os2Version4Fields = Os2Version4Fields
+    { ulCodePageRange1 :: Word32
+    , ulCodePageRange2 :: Word32
+    , sxHeight :: Int16
+    , sCapHeight :: Int16
+    , usDefaultChar :: Word16
+    , usBreakChar :: Word16
+    , usMaxContext :: Word16
+    } deriving (Eq, Show)
+
+data Os2Version5Fields = Os2Version5Fields
+    { ulCodePageRange1 :: Word32
+    , ulCodePageRange2 :: Word32
+    , sxHeight :: Int16
+    , sCapHeight :: Int16
+    , usDefaultChar :: Word16
+    , usBreakChar :: Word16
+    , usMaxContext :: Word16
+    , usLowerOpticalPointSize :: Word16
+    , usUpperOpticalPointSize :: Word16
+    } deriving (Eq, Show)
+
+data Os2BaseFields = Os2BaseFields
+    { version :: Word16 -- ^ Table version number (set to 0).
+    -- | Average weighted advance width of lower case letters and space.
+    , xAvgCharWidth :: Int16
+    -- | Visual weight (degree of blackness or thickness) of stroke in glyphs.
+    , usWeightClass :: Word16
+    -- | Relative change from the normal aspect ratio (width to height ratio)
+    -- as specified by a font designer for the glyphs in the font.
+    , usWidthClass :: Word16
+    -- | Characteristics and properties of this font (set undefined bits to
+    -- zero).
+    , fsType :: Int16
+    -- | Recommended horizontal size in pixels for subscripts.
+    , ySubscriptXSize :: Int16
+    -- | Recommended vertical size in pixels for subscripts.
+    , ySubscriptYSize :: Int16
+    -- | Recommended horizontal offset for subscripts.
+    , ySubscriptXOffset :: Int16
+    -- | Recommended vertical offset form the baseline for subscripts.
+    , ySubscriptYOffset :: Int16
+    -- | Recommended horizontal size in pixels for superscripts.
+    , ySuperscriptXSize :: Int16
+    -- | Recommended vertical size in pixels for superscripts.
+    , ySuperscriptYSize :: Int16
+    -- | Recommended horizontal offset for superscripts.
+    , ySuperscriptXOffset :: Int16
+    -- | Recommended vertical offset from the baseline for superscripts.
+    , ySuperscriptYOffset :: Int16
+    -- | Width of the strikeout stroke.
+    , yStrikeoutSize :: Int16
+    -- | Position of the strikeout stroke relative to the baseline.
+    , yStrikeoutPosition :: Int16
+    -- ^ Classification of font-family design.
+    , sFamilyClass :: Int16
+    -- | 10 byte series of number used to describe the visual characteristics
+    -- of a given typeface.
+    , panose :: Panose
+    -- | Field is split into two bit fields of 96 and 36 bits each. The low 96
+    -- bits are used to specify the Unicode blocks encompassed by the font file.
+    -- The high 32 bits are used to specify the character or script sets covered
+    -- by the font file. Bit assignments are pending. Set to 0.
+    , ulUnicodeRange :: Vector Word32
+    -- | Four character identifier for the font vendor.
+    , achVendID :: Vector Int8
+    -- | 2-byte bit field containing information concerning the nature of the
+    -- font patterns.
+    , fsSelection :: Word16
+    -- | The minimum Unicode index in this font.
+    , fsFirstCharIndex :: Word16
+    -- | The maximum Unicode index in this font.
+    , fsLastCharIndex :: Word16
+    } deriving (Eq, Show)
+
+data Panose = Panose
+    { bFamilyType :: BFamilyType
+    , bSerifStyle :: BSerifStyle
+    , bWeight :: BWeight
+    , bProportion :: BProportion
+    , bContrast :: BContrast
+    , bStrokeVariation :: BStrokeVariation
+    , bArmStyle :: BArmStyle
+    , bLetterform :: BLetterform
+    , bMidline :: BMidline
+    , bXHeight :: BXHeight
+    } deriving (Eq, Show)
+
+data BFamilyType
+    = AnyFamilyType
+    | NoFitFamilyType
+    | TextAndDisplayFamilyType
+    | ScriptFamilyType
+    | DecorativeFamilyType
+    | PictorialFamilyType
+    deriving (Eq, Show)
+
+data BSerifStyle
+    = AnySerifStyle
+    | NoFitSerifStyle
+    | CoveSerifStyle
+    | ObtuseCoveSerifStyle
+    | SquareCoveSerifStyle
+    | ObtuseSquareCoveSerifStyle
+    | SquareSerifStyle
+    | ThinSerifStyle
+    | BoneSerifStyle
+    | ExaggeratedSerifStyle
+    | TriangleSerifStyle
+    | NormalSansSerifStyle
+    | ObtuseSansSerifStyle
+    | PerpSansSerifStyle
+    | FlaredSerifStyle
+    | RoundedSerifStyle
+    deriving (Eq, Show)
+
+data BWeight
+    = AnyWeight
+    | NoFitWeight
+    | VeryLightWeight
+    | LightWeight
+    | ThinWeight
+    | BookWeight
+    | MediumWeight
+    | DemiWeight
+    | BoldWeight
+    | HeavyWeight
+    | BlackWeight
+    | NordWeight
+    deriving (Eq, Show)
+
+data BProportion
+    = AnyProportion
+    | NoFitProportion
+    | OldStyleProportion
+    | ModernProportion
+    | EvenWidthProportion
+    | ExpandedProportion
+    | CondensedProportion
+    | VeryExpandedProportion
+    | VeryCondensedProportion
+    | MonospacedProportion
+    deriving (Eq, Show)
+
+data BContrast
+    = AnyContrast
+    | NoFitContrast
+    | NoneContrast
+    | VeryLowContrast
+    | LowContrast
+    | MediumLowContrast
+    | MediumContrast
+    | MediumHighContrast
+    | HighContrast
+    | VeryHighContrast
+    deriving (Eq, Show)
+
+data BStrokeVariation
+    = AnyStrokeVariatoon
+    | NoFitStrokeVariatoon
+    | GradualDiagonalStrokeVariatoon
+    | GradualTransitionalStrokeVariatoon
+    | GradualVerticalStrokeVariatoon
+    | GradualHorizontalStrokeVariatoon
+    | RapidVerticalStrokeVariatoon
+    | RapidHorizontalStrokeVariatoon
+    | InstantVerticalStrokeVariatoon
+    deriving (Eq, Show)
+
+data BArmStyle
+    = AnyArmStyle
+    | NoFitArmStyle
+    | StraightArmsHorizontalArmStyle
+    | StraightArmsWedgeArmStyle
+    | StraightArmsVerticalArmStyle
+    | StraightArmsSingleSerifArmStyle
+    | StraightArmsDoubleSerifArmStyle
+    | NonStraightArmsHorizontalArmStyle
+    | NonStraightArmsWedgeArmStyle
+    | NonStraightArmsVerticalArmStyle
+    | NonStraightArmsSingleSerifArmStyle
+    | NonStraightArmsDoubleSerifArmStyle
+    deriving (Eq, Show)
+
+data BLetterform
+    = AnyLetterform
+    | NoFitLetterform
+    | NormalContactLetterform
+    | NormalWeightedLetterform
+    | NormalBoxedLetterform
+    | NormalFlattenedLetterform
+    | NormalRoundedLetterform
+    | NormalOffCenterLetterform
+    | NormalSquareLetterform
+    | ObliqueContactLetterform
+    | ObliqueWeightedLetterform
+    | ObliqueBoxedLetterform
+    | ObliqueFlattenedLetterform
+    | ObliqueRoundedLetterform
+    | ObliqueOffCenterLetterform
+    | ObliqueSquareLetterform
+    deriving (Eq, Show)
+
+data BMidline
+    = AnyMidline
+    | NoFitMidline
+    | StandardTrimmedMidline
+    | StandardPointedMidline
+    | StandardSerifedMidline
+    | HighTrimmedMidline
+    | HighPointedMidline
+    | HighSerifedMidline
+    | ConstantTrimmedMidline
+    | ConstantPointedMidline
+    | ConstantSerifedMidline
+    | LowTrimmedMidline
+    | LowPointedMidline
+    | LowSerifedMidline
+    deriving (Eq, Show)
+
+data BXHeight
+    = AnyXHeight
+    | NoFitXHeight
+    | ConstantSmallXHeight
+    | ConstantStandardXHeight
+    | ConstantLargeXHeight
+    | DuckingSmallXHeight
+    | DuckingStandardXHeight
+    | DuckingLargeXHeight
+    deriving (Eq, Show)
+
+-- * Kern table
+
+data KernHeader = KernHeader
+    { version :: Fixed32 -- ^ The version number of the kerning table (0x00010000 for the current version).
+    } deriving (Eq, Show)
+
+data KernSubtableHeader = KernSubtableHeader
+    -- | The length of this subtable in bytes, including this header.
+    { length :: Word32
+    -- | Circumstances under which this table is used.
+    , coverage :: [Coverage]
+    -- | The tuple index (used for variations fonts). This value specifies which
+    -- tuple this subtable covers.
+    , tupleIndex :: Word16
+    } deriving (Eq, Show)
+
+data Coverage
+    = KernVertical -- ^ Set if table has vertical kerning values.
+    | KernCrossStream -- ^ Set if table has cross-stream kerning values.
+    | KernVariation -- ^ Set if table has variation kerning values.
+    | KernUnusedBits -- ^ Set to 0.
+    | KernFormatMask -- ^ Set the format of this subtable (0-3 currently defined).
+    deriving (Eq, Show)
+
+data KernFormat0Pair = KernFormat0Pair
+    { left :: Word16 -- ^ The glyph index for the lefthand glyph in the kerning pair.
+    , right :: Word16 -- ^ The glyph index for the righthand glyph in the kerning pair.
+    -- | The kerning value in FUnits for the left and right pair in FUnits.
+    -- If this value is greater than zero, the glyphs are moved apart.
+    -- If this value is less than zero, the glyphs are moved together.
+    , value :: Int16
+    } deriving (Eq, Show)
+
+data KernFormat0Table = KernFormat0Table
+    { nPairs :: Word16 -- ^ The number of kerning pairs in this subtable.
+    , searchRange :: Word16 -- ^ The largest power of two less than or equal to the value of nPairs, multiplied by the size in bytes of an entry in the subtable.
+    -- | This is calculated as log2 of the largest power of two less than or
+    -- equal to the value of nPairs. This value indicates how many iterations of
+    -- the search loop have to be made. For example, in a list of eight items,
+    -- there would be three iterations of the loop.
+    , entrySelector :: Word16
+    -- | The value of nPairs minus the largest power of two less than or equal
+    -- to nPairs. This is multiplied by the size in bytes of an entry in the
+    -- table.
+    , rangeShift :: Word16
+    , pairs :: [KernFormat0Pair]
+    } deriving (Eq, Show)
diff --git a/src/Graphics/Fountainhead/Type.hs b/src/Graphics/Fountainhead/Type.hs
new file mode 100644
index 0000000..3dc2a3f
--- /dev/null
+++ b/src/Graphics/Fountainhead/Type.hs
@@ -0,0 +1,14 @@
+-- | Generic font types.
+module Graphics.Fountainhead.Type
+    ( F2Dot14(..)
+    , Fixed32(..)
+    ) where
+
+import Data.Int (Int16)
+import Data.Word (Word32)
+
+newtype Fixed32 = Fixed32 Word32
+    deriving (Eq, Show)
+
+newtype F2Dot14 = F2Dot14 Int16
+    deriving (Eq, Show)