Dump the post table

2 files changed, 55 insertions, 5 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index dc23b4a..304960e 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- | Outputs information about a font as text.
@@ -19,6 +20,7 @@ module Graphics.Fountainhead.Dumper
     , dumpLoca
     , dumpName
     , dumpMaxp
+    , dumpPost
     , dumpTrueType
     , dumpOffsetTable
     ) where
@@ -46,6 +48,10 @@ import Graphics.Fountainhead.TrueType
     , HheaTable(..)
     , HmtxTable(..)
     , OffsetSubtable(..)
+    , PostHeader(..)
+    , PostSubtable(..)
+    , PostFormat2Table(..)
+    , PostTable(..)
     , TableDirectory(..)
     , CmapEncoding(..)
     , CmapSubtable(..)
@@ -70,7 +76,9 @@ import Graphics.Fountainhead.Parser
     , hheaTableP
     , hmtxTableP
     , locaTableP
-    , maxpTableP, nameTableP
+    , maxpTableP
+    , nameTableP
+    , postTableP
     )
 import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
 import Data.Foldable (Foldable(..), find)
@@ -233,6 +241,44 @@ longDateTime localTime = Text.Builder.fromLazyText
     $ (truncate :: NominalDiffTime -> Int)
     $ diffLocalTime localTime (LocalTime ttfEpoch midnight)
 
+dumpPost :: PostTable -> Text.Builder.Builder
+dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable }
+    = dumpCaption "'post' Table - PostScript" <> newlineBuilder
+    <> "         'post' format:          " <> dumpFixed32 format <> newlineBuilder
+    <> "         italicAngle:            " <> dumpFixed32 format <> newlineBuilder
+    <> "         underlinePosition:      " <> Text.Builder.decimal underlinePosition <> newlineBuilder
+    <> "         underlineThichness:     " <> Text.Builder.decimal underlineThickness <> newlineBuilder
+    <> "         isFixedPitch:           " <> dNumber isFixedPitch <> newlineBuilder
+    <> "         minMemType42:           " <> dNumber minMemType42 <> newlineBuilder
+    <> "         maxMemType42:           " <> dNumber maxMemType42 <> newlineBuilder
+    <> "         minMemType1:            " <> dNumber minMemType1 <> newlineBuilder
+    <> "         maxMemType1:            " <> dNumber maxMemType1 <> newlineBuilder
+    <> dumpPostSubtable
+  where
+    dNumber = (<> Text.Builder.singleton 'd') . Text.Builder.decimal
+    dumpPostSubtable = case postSubtable of
+        None -> "" -- Format 1 and 3 do not require a subtable.
+        PostFormat2 PostFormat2Table{..}
+            -> "         Format 2.0:  Non-Standard (for PostScript) TrueType Glyph Set." <> newlineBuilder
+            <> "                 numGlyphs:      " <> Text.Builder.decimal (Prelude.length glyphNameIndex)
+            <> newlineBuilder <> fold (Vector.imap (dumpFormat2Pair names) glyphNameIndex)
+        PostFormat25 _ -> "Format 2.5"
+        PostFormat4 _ -> "Format 4.0"
+    dumpFormat2Pair names index glyphNameIndex'
+        = "                 Glyf " <> justifyNumber 3 index
+        <> "  -> " <> glyphType names glyphNameIndex'
+        <> newlineBuilder
+    glyphType names glyphNameIndex'
+        | glyphNameIndex' >= 0
+        , glyphNameIndex' <= 257 = "Mac Glyph # " <> justifyNumber 3 glyphNameIndex'
+        | glyphNameIndex' >= 258
+        , glyphNameIndex' <= 32767 =
+            let nameIndex = fromIntegral $ glyphNameIndex' - 258
+             in "PSGlyph Name # " <> justifyNumber 3 (succ nameIndex) <> ", '"
+                <> Text.Builder.fromText (Text.decodeASCII (names Vector.! nameIndex))
+                <> Text.Builder.singleton '\''
+        | otherwise = "Reserved"
+
 dumpCmap :: CmapTable -> Text.Builder.Builder
 dumpCmap CmapTable{..}
     = dumpCaption "'cmap' Table - Character to Glyph Index Mapping Table"
@@ -383,15 +429,18 @@ dumpHexString byteCodes
             <> separator
             <> printables
             <> newlineBuilder
-    hexByte = Text.Builder.fromLazyText
-        . Text.Lazy.justifyRight 2 '0'
-        . Text.Builder.toLazyText . Text.Builder.hexadecimal
     printableByte :: Word8 -> Text.Builder.Builder
     printableByte code
         | code >= 0x20
         , code < 0x7f = Text.Builder.singleton $ toEnum $ fromIntegral code
         | otherwise = Text.Builder.singleton '.'
 
+hexByte :: Integral a => a -> Text.Builder.Builder
+hexByte = Text.Builder.fromLazyText
+    . Text.Lazy.justifyRight 2 '0'
+    . Text.Builder.toLazyText
+    . Text.Builder.hexadecimal
+
 dumpMaxp :: MaxpTable -> Text.Builder.Builder
 dumpMaxp (TrueMaxp TrueMaxpTable{..})
     = dumpCaption "'maxp' Table - Maximum Profile"
@@ -450,6 +499,7 @@ dumpTables processedState directory@FontDirectory{..}
                 <$> parseTable tableEntry (locaTableP $ getField @"indexToLocFormat" headTable) processedState
             "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
             "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
+            "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
             _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder
diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs
index 209faa2..2e86696 100644
--- a/src/Graphics/Fountainhead/Parser.hs
+++ b/src/Graphics/Fountainhead/Parser.hs
@@ -692,7 +692,7 @@ cmapFormatTableP = do
 cmapFormat14TableP :: Parser CmapFormat14Table
 cmapFormat14TableP = do
     initialOffset <- (+ (-2)) <$> Megaparsec.getOffset
-    Megaparsec.Binary.word32be -- Length.
+    void Megaparsec.Binary.word32be -- Length.
     numVarSelectorRecords <- fromIntegral <$> Megaparsec.Binary.word32be
     variationSelectorRecords' <- sortBy sortOffset . fold
         <$> Megaparsec.count numVarSelectorRecords variationSelectorRecordP