Dump cmap segment summary

1 files changed, 32 insertions, 11 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index dfa760f..680c0f7 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -41,6 +41,7 @@ import Graphics.Fountainhead.Parser
     , parseTable
     , cmapTableP
     )
+import Data.Foldable (Foldable(..))
 
 type ParseErrorOrDump
     = Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@@ -52,6 +53,12 @@ paddedHexadecimal = ("0x" <>)
     . Text.Builder.toLazyText
     . Text.Builder.hexadecimal
 
+halfPaddedHexadecimal :: Integral a => a -> Text.Builder.Builder
+halfPaddedHexadecimal = Text.Builder.fromLazyText
+    . Text.Lazy.justifyRight 4 '0'
+    . Text.Builder.toLazyText
+    . Text.Builder.hexadecimal
+
 justifyNumber :: Integral a => Int64 -> a -> Text.Builder.Builder
 justifyNumber count = Text.Builder.fromLazyText
     . Text.Lazy.justifyRight count ' '
@@ -120,23 +127,37 @@ dumpCmap CmapTable{..}
         (CmapFormat0 _) -> "Format 0"
         (CmapFormat2 _) -> "Format 2"
         (CmapFormat4 CmapFormat4Table{..}) ->
-            "Format 4 - Segment mapping to delta values\n\
-            \                 Length:     994\n\
-            \                 Version:      0\n\
-            \                 segCount:       "
-            <> Text.Builder.decimal (Vector.length startCode)
-            <> newlineBuilder <> "                 searchRange:    "
-            <> Text.Builder.decimal searchRange
-            <> newlineBuilder <> "                 entrySelector:  "
-            <> Text.Builder.decimal entrySelector
-            <> newlineBuilder <> "                 rangeShift:     "
-            <> Text.Builder.decimal (Vector.length startCode * 2 - fromIntegral searchRange)
+            let segCount = Vector.length startCode
+             in "Format 4 - Segment mapping to delta values\n\
+                \                 Length:     994\n\
+                \                 Version:      0\n\
+                \                 segCount:       "
+                <> Text.Builder.decimal segCount
+                <> newlineBuilder <> "                 searchRange:    "
+                <> Text.Builder.decimal searchRange
+                <> newlineBuilder <> "                 entrySelector:  "
+                <> Text.Builder.decimal entrySelector
+                <> newlineBuilder <> "                 rangeShift:     "
+                <> Text.Builder.decimal (segCount * 2 - fromIntegral searchRange)
+                <> newlineBuilder
+                <> fold (Vector.izipWith4 (dumpSegment segCount) startCode endCode idDelta idRangeOffset)
         (CmapFormat6 _) -> "Format 6"
         (CmapFormat8 _) -> "Format 8"
         (CmapFormat10 _) -> "Format 10"
         (CmapFormat12 _) -> "Format 12"
         (CmapFormat13 _) -> "Format 13"
         (CmapFormat14 _) -> "Format 14"
+    dumpSegment segCount index startCode' endCode' idDelta' idRangeOffset'
+        = "                 Seg " <> justifyNumber 5 index
+        <> " : St = " <> halfPaddedHexadecimal startCode'
+        <> ", En = " <> halfPaddedHexadecimal endCode'
+        <> ", D = " <> justifyNumber 6 idDelta'
+        <> ", RO = " <> justifyNumber 6 idRangeOffset'
+        <> ", gId# = " <> dumpGlyphId index segCount idRangeOffset'
+        <> newlineBuilder
+    dumpGlyphId index segCount idRangeOffset'
+        | idRangeOffset' == 0 = "N/A"
+        | otherwise = Text.Builder.decimal $ index - segCount + (fromIntegral idRangeOffset' `div` 2)
 
 dumpTables
     :: Megaparsec.State ByteString Void