Dump the offset subtable

app/Main.hs

@@ -2,10 +2,19 @@ module Main
     ( main
     ) where
 
+import Control.Monad (foldM_)
+import Data.Int (Int64)
 import qualified Data.ByteString as ByteString
+import qualified Data.ByteString.Char8 as Char8
 import Data.ByteString (ByteString)
 import qualified Text.Megaparsec as Megaparsec
 import Data.Foldable (find)
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import qualified Data.Text.Lazy.Builder.Int as Text.Builder
+import qualified Data.Text.Lazy as Text.Lazy
+import qualified Data.Text.Lazy.IO as Text.Lazy
+import qualified Data.Text.Encoding as Text
+import GHC.Records (HasField(..))
 -- TODO: kern table since format 1.
 -- For details on subtable format see examples in TrueType reference.
 import Graphics.Fountainhead.Parser
@@ -14,13 +23,19 @@ import Graphics.Fountainhead.Parser
     , parseTable
     , shortLocaTableP
     )
-import Graphics.Fountainhead.TrueType (FontDirectory(..), TableDirectory(..))
+import Graphics.Fountainhead.TrueType
+    ( FontDirectory(..)
+    , OffsetSubtable(..)
+    , TableDirectory(..)
+    )
 import System.Environment (getArgs)
 import System.Exit (exitWith)
 import GHC.IO.Exception (ExitCode(..))
 
 fontMain :: FilePath -> IO ()
 fontMain fontFile = do
+    putStrLn $ "Dumping File:" <> fontFile <> "\n\n"
+
     ttfContents <- ByteString.readFile fontFile
 
     let initialState = Megaparsec.State
@@ -36,12 +51,47 @@ fontMain fontFile = do
             , stateParseErrors = []
             }
         (processedState, Right directory) = Megaparsec.runParser' fontDirectoryP initialState
-    print directory
+
+    Text.Lazy.putStrLn $ Text.Builder.toLazyText $ dumpOffsetTable directory
+    {- print directory
     let Just tableDirectory' = find (("OS/2" ==) . tag) $ tableDirectory directory
         tableResult = parseTable tableDirectory' os2TableP processedState
     case tableResult of
         Left e -> putStr (Megaparsec.errorBundlePretty e)
-        Right x -> print x
+        Right x -> print x -}
+
+paddedHexadecimal :: Integral a => a -> Text.Builder.Builder
+paddedHexadecimal = ("0x" <>)
+    . Text.Builder.fromLazyText
+    . Text.Lazy.justifyRight 8 '0'
+    . Text.Builder.toLazyText
+    . Text.Builder.hexadecimal
+
+justifyNumber :: Integral a => Int64 -> a -> Text.Builder.Builder
+justifyNumber count = Text.Builder.fromLazyText
+    . Text.Lazy.justifyRight count ' '
+    . Text.Builder.toLazyText
+    . Text.Builder.decimal
+
+dumpOffsetTable :: FontDirectory -> Text.Builder.Builder
+dumpOffsetTable directory
+    = "Offset Table\n------------\n"
+    <> "         sfnt version:           1.0\n         number of tables: "
+    <> Text.Builder.decimal (numTables $ offsetSubtable directory)
+    <> Text.Builder.singleton '\n'
+    <> dumpOffsetSummary (tableDirectory directory)
+  where
+    dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0..]
+    dumpOffsetRow (index, table) = justifyNumber 4 index
+        <> ". '"
+        <> Text.Builder.fromText (Text.decodeASCII $ tag table)
+        <> "' - checksum = "
+        <> paddedHexadecimal (getField @"checkSum" table)
+        <> ", offset = "
+        <> paddedHexadecimal (getField @"offset" table)
+        <> ", len = "
+        <> justifyNumber 9 (getField @"length" table)
+        <> Text.Builder.singleton '\n'
 
 main :: IO ()
 main = do