1 files changed, 53 insertions, 8 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index e7c6156..f09469d 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -12,6 +12,7 @@
 module Graphics.Fountainhead.Dumper
     ( ParseErrorOrDump
     , dumpCmap
+    , dumpHead
     , dumpTrueType
     , dumpOffsetTable
     ) where
@@ -31,20 +32,26 @@ import GHC.Records (HasField(..))
 import Graphics.Fountainhead.TrueType
     ( CmapTable(..)
     , FontDirectory(..)
+    , HeadTable(..)
     , OffsetSubtable(..)
     , TableDirectory(..)
     , CmapEncoding(..)
     , CmapSubtable(..)
     , CmapFormat4Table(..)
+    , FontStyle(..)
     )
 import qualified Text.Megaparsec as Megaparsec
 import Graphics.Fountainhead.Parser
     ( fontDirectoryP
     , parseTable
     , cmapTableP
+    , headTableP
     )
+import Graphics.Fountainhead.Type (ttfEpoch)
 import Data.Foldable (Foldable(..))
 import Data.Maybe (fromMaybe)
+import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
+import Data.Bits (Bits(setBit))
 
 type ParseErrorOrDump
     = Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@@ -71,8 +78,8 @@ justifyNumber count = Text.Builder.fromLazyText
 newlineBuilder :: Text.Builder.Builder
 newlineBuilder = Text.Builder.singleton '\n'
 
-dumpHead :: String -> Text.Builder.Builder
-dumpHead headline = Text.Builder.fromString headline
+dumpCaption :: String -> Text.Builder.Builder
+dumpCaption headline = Text.Builder.fromString headline
     <> newlineBuilder
     <> Text.Builder.fromLazyText (Text.Lazy.replicate headlineLength "-")
     <> newlineBuilder
@@ -81,7 +88,7 @@ dumpHead headline = Text.Builder.fromString headline
 
 dumpOffsetTable :: FontDirectory -> Text.Builder.Builder
 dumpOffsetTable directory
-    = dumpHead "Offset Table"
+    = dumpCaption "Offset Table"
     <> "         sfnt version:           1.0\n         number of tables: "
     <> Text.Builder.decimal (numTables $ offsetSubtable directory)
     <> newlineBuilder
@@ -99,9 +106,46 @@ dumpOffsetTable directory
         <> justifyNumber 9 (getField @"length" table)
         <> newlineBuilder
 
+dumpHead :: HeadTable -> Text.Builder.Builder
+dumpHead HeadTable{..}
+    = dumpCaption "'head' Table - Font Header"
+    {- version
+    <> lowestRecPPEM
+    <> indexToLocFormat
+    <> glyphDataFormat
+    <> fontRevision
+    <> fontDirectionHint -}
+    <> "         checkSumAdjustment:     " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
+    <> "         magicNumber:            " <> paddedHexadecimal magicNumber <> newlineBuilder
+    <> "         flags:                  0x" <> halfPaddedHexadecimal flags <> newlineBuilder
+    <> "         unitsPerEm:             " <> Text.Builder.decimal unitsPerEm <> newlineBuilder
+    <> "         created:                " <> "0x" <> longDateTime created <> newlineBuilder
+    <> "         modified:               " <> "0x" <> longDateTime modified <> 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
+    <> "         macStyle bits:          " <> "0x" <> dumpFontStyle macStyle <> newlineBuilder
+
+dumpFontStyle :: FontStyle -> Text.Builder.Builder
+dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
+    $ foldr (go . fst) (0 :: Int)
+    $ filter snd
+    $ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
+  where
+    go bitNumber accumulator = setBit accumulator bitNumber
+
+longDateTime :: LocalTime -> Text.Builder.Builder
+longDateTime localTime = Text.Builder.fromLazyText
+    $ Text.Lazy.justifyRight 16 '0'
+    $ Text.Builder.toLazyText
+    $ Text.Builder.hexadecimal
+    $ (truncate :: NominalDiffTime -> Int)
+    $ diffLocalTime localTime (LocalTime ttfEpoch midnight)
+
 dumpCmap :: CmapTable -> Text.Builder.Builder
 dumpCmap CmapTable{..}
-    = dumpHead "'cmap' Table - Character to Glyph Index Mapping Table"
+    = dumpCaption "'cmap' Table - Character to Glyph Index Mapping Table"
     <> "        'cmap' version: " <> Text.Builder.decimal version <> newlineBuilder
     <> "        number of encodings: " <> Text.Builder.decimal encodingsLength <> newlineBuilder
     <> "        number of subtables: " <> Text.Builder.decimal (Prelude.length subtables) <> newlineBuilder
@@ -200,11 +244,11 @@ dumpTables
     -> FontDirectory
     -> ParseErrorOrDump
 dumpTables processedState directory@FontDirectory{..}
-    = foldr go (Right $ dumpOffsetTable directory) tableDirectory
+    = foldl' go (Right $ dumpOffsetTable directory) tableDirectory
   where
-    go :: TableDirectory -> ParseErrorOrDump -> ParseErrorOrDump
-    go _ (Left accumulator) = Left accumulator
-    go tableEntry (Right accumulator)
+    go :: ParseErrorOrDump -> TableDirectory -> ParseErrorOrDump
+    go (Left accumulator) _ = Left accumulator
+    go (Right accumulator) tableEntry
         = maybe (Right accumulator) (concatDump accumulator)
         $ dumpSubTable tableEntry
     concatDump accumulator builderDump = ((accumulator <> newlineBuilder) <>)
@@ -212,6 +256,7 @@ dumpTables processedState directory@FontDirectory{..}
     dumpSubTable tableEntry =
         case getField @"tag" tableEntry of
             "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
+            "head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState
             _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump