Dump cmap format 4 subtable summary

1 files changed, 35 insertions, 3 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index 7216f96..dfa760f 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- | Outputs information about a font as text.
 module Graphics.Fountainhead.Dumper
@@ -22,13 +23,17 @@ import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Lazy as Text.Lazy
 import qualified Data.Text.Lazy.Builder as Text.Builder
 import qualified Data.Text.Lazy.Builder.Int as Text.Builder
+import qualified Data.Vector as Vector
 import Data.Void
 import GHC.Records (HasField(..))
 import Graphics.Fountainhead.TrueType
     ( CmapTable(..)
     , FontDirectory(..)
     , OffsetSubtable(..)
-    , TableDirectory(..), CmapEncoding (..)
+    , TableDirectory(..)
+    , CmapEncoding(..)
+    , CmapSubtable(..)
+    , CmapFormat4Table(..)
     )
 import qualified Text.Megaparsec as Megaparsec
 import Graphics.Fountainhead.Parser
@@ -72,7 +77,7 @@ dumpOffsetTable directory
     <> newlineBuilder
     <> dumpOffsetSummary (tableDirectory directory)
   where
-    dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0..]
+    dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0 :: Int ..]
     dumpOffsetRow (index, table) = justifyNumber 4 index
         <> ". '"
         <> Text.Builder.fromText (Text.decodeASCII $ tag table)
@@ -92,8 +97,10 @@ dumpCmap CmapTable{..}
     <> "        number of subtables: " <> Text.Builder.decimal (Prelude.length subtables) <> newlineBuilder
     <> newlineBuilder
     <> snd (foldr dumpCmapEncoding (pred encodingsLength, "") encodings) <> newlineBuilder
+    <> snd (foldr dumpCmapSubTable (pred subTablesLength, "") subtables) <> newlineBuilder
   where
     encodingsLength = Prelude.length encodings
+    subTablesLength = IntMap.size subtables
     dumpCmapEncoding CmapEncoding{..} (index, accumulator) =
         let findSubTableIndex = Text.Builder.decimal
                 . Prelude.length
@@ -105,6 +112,31 @@ dumpCmap CmapTable{..}
                 <> "                 SubTable: " <> findSubTableIndex subtables
                 <> ", Offset: " <> paddedHexadecimal offset <> newlineBuilder
          in (pred index, summary <> newlineBuilder <> accumulator)
+    dumpCmapSubTable currentSubTable (index, accumulator) =
+        let contents = "SubTable   " <> Text.Builder.decimal index
+                <> ".    " <> dumpCmapSubTableFormat currentSubTable
+         in (pred index, contents <> accumulator)
+    dumpCmapSubTableFormat = \case
+        (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)
+        (CmapFormat6 _) -> "Format 6"
+        (CmapFormat8 _) -> "Format 8"
+        (CmapFormat10 _) -> "Format 10"
+        (CmapFormat12 _) -> "Format 12"
+        (CmapFormat13 _) -> "Format 13"
+        (CmapFormat14 _) -> "Format 14"
 
 dumpTables
     :: Megaparsec.State ByteString Void
@@ -114,7 +146,7 @@ dumpTables processedState directory@FontDirectory{..}
     = foldr go (Right $ dumpOffsetTable directory) tableDirectory
   where
     go :: TableDirectory -> ParseErrorOrDump -> ParseErrorOrDump
-    go tableEntry (Left accumulator) = Left accumulator
+    go _ (Left accumulator) = Left accumulator
     go tableEntry (Right accumulator)
         = maybe (Right accumulator) (concatDump accumulator)
         $ dumpSubTable tableEntry