Dump the glyf table

1 files changed, 50 insertions, 5 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index b060de7..8925694 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -61,6 +61,10 @@ import Graphics.Fountainhead.TrueType
     , CmapSubtable(..)
     , CmapFormat4Table(..)
     , FontStyle(..)
+    , GlyphCoordinate(..)
+    , GlyphDefinition(..)
+    , GlyphDescription(..)
+    , GlyfTable(..)
     , LongHorMetric(..)
     , LocaTable(..)
     , NameRecord (..)
@@ -77,6 +81,7 @@ import Graphics.Fountainhead.TrueType
     , Os2Version5Fields(..)
     , Os2Table(..)
     , Panose(..)
+    , SimpleGlyphDefinition(..)
     , CVTable(..)
     )
 import qualified Text.Megaparsec as Megaparsec
@@ -94,6 +99,7 @@ import Graphics.Fountainhead.Parser
     , os2TableP
     , postTableP
     , cvTableP
+    , glyfTableP
     )
 import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
 import Data.Foldable (Foldable(..), find)
@@ -110,6 +116,7 @@ data DumpError
 data RequiredTables = RequiredTables
     { hheaTable :: HheaTable
     , headTable :: HeadTable
+    , locaTable :: LocaTable
     } deriving (Eq, Show)
 
 paddedHexadecimal :: Integral a => a -> Text.Builder.Builder
@@ -634,6 +641,37 @@ dumpGASP GASPTable{..} = dumpCaption "'gasp' Table - Grid-fitting And Scan-conve
         <> "         rangeMaxPPEM:   " <> Text.Builder.decimal rangeMaxPPEM <> newlineBuilder
         <> "         rangeGaspBehavior:      0x" <> halfPaddedHexadecimal rangeGaspBehavior <> newlineBuilder
 
+dumpGlyf :: GlyfTable -> Text.Builder.Builder
+dumpGlyf (GlyfTable glyfDescriptions) = dumpCaption "'glyf' Table - Glyf data"
+    <> foldMap go (Vector.indexed glyfDescriptions)
+  where
+    go (glyphIndex, GlyphDescription{..})
+        = "Glyph " <> justifyNumber 6 glyphIndex <> Text.Builder.singleton '.' <> newlineBuilder
+        <> "         numberOfContours:       " <> Text.Builder.decimal numberOfContours <> newlineBuilder
+        <> "         xMin:                   " <> Text.Builder.decimal xMin <> newlineBuilder
+        <> "         yMin:                   " <> Text.Builder.decimal yMin <> newlineBuilder
+        <> "         xMax:                   " <> Text.Builder.decimal xMax <> newlineBuilder
+        <> "         yMax:                   " <> Text.Builder.decimal yMax <> newlineBuilder
+        <> newlineBuilder <> dumpGlyphDefinition definition <> newlineBuilder
+    dumpEndPoint (endPointIndex, endPoint)
+        = "         " <> justifyNumber 2 endPointIndex
+        <> ":  " <> Text.Builder.decimal endPoint <> newlineBuilder
+    dumpGlyphDefinition (SimpleGlyph SimpleGlyphDefinition{..})
+        = "         EndPoints" <> newlineBuilder
+        <> "         ---------" <> newlineBuilder
+        <> foldMap dumpEndPoint (Vector.indexed endPtsOfContours) <> newlineBuilder
+        <> "         Length of Instructions: "
+        <> Text.Builder.decimal (Vector.length instructions) <> newlineBuilder
+        <> "         Flags" <> newlineBuilder
+        <> "         -----" <> newlineBuilder
+        <> foldMap dumpFlag (Vector.indexed coordinates) <>  newlineBuilder <> newlineBuilder
+    dumpGlyphDefinition _ = ""
+    dumpFlag (coordinateIndex, GlyphCoordinate{..})
+        = "         " <> justifyNumber 2 coordinateIndex <> ": "
+        <> Text.Builder.decimal coordinateX <> " " <> Text.Builder.decimal coordinateY <> " "
+        <> (if onCurve then "On" else "Off")
+        <> newlineBuilder
+
 dumpTables
     :: Megaparsec.State ByteString Void
     -> FontDirectory
@@ -644,9 +682,16 @@ dumpTables processedState directory@FontDirectory{..}
     traverseDirectory parsedRequired =
         let initial = Right $ dumpOffsetTable directory
          in foldl' (go parsedRequired) initial tableDirectory
-    parseRequired = RequiredTables
-        <$> findRequired "hhea" hheaTableP
-        <*> findRequired "head" headTableP
+    parseRequired = do
+        requiredHhea <- findRequired "hhea" hheaTableP
+        requiredHead@HeadTable{ indexToLocFormat } <-
+            findRequired "head" headTableP
+        requiredLoca <- findRequired "loca" (locaTableP indexToLocFormat)
+        pure $ RequiredTables
+            { hheaTable = requiredHhea
+            , headTable = requiredHead 
+            , locaTable = requiredLoca
+            } 
     findRequired tableName parser = 
         let missingError = Left $ DumpRequiredTableMissingError tableName
             parseFound tableEntry = parseTable tableEntry parser processedState
@@ -665,14 +710,14 @@ dumpTables processedState directory@FontDirectory{..}
             "hhea" -> Just $ Right $ dumpHhea hheaTable
             "hmtx" -> Just $ dumpHmtx
                 <$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState
-            "loca" -> Just $ dumpLoca
-                <$> parseTable tableEntry (locaTableP $ getField @"indexToLocFormat" headTable) processedState
+            "loca" -> Just $ Right $ dumpLoca locaTable
             "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
             "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
             "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
             "OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
             "cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
             "gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState
+            "glyf" -> Just $ dumpGlyf <$> parseTable tableEntry (glyfTableP locaTable) processedState
             _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder