Dump the hhea table

src/Graphics/Fountainhead/Dumper.hs

@@ -32,7 +32,9 @@ import GHC.Records (HasField(..))
 import Graphics.Fountainhead.TrueType
     ( CmapTable(..)
     , FontDirectory(..)
+    , FontDirectionHint(..)
     , HeadTable(..)
+    , HheaTable(..)
     , OffsetSubtable(..)
     , TableDirectory(..)
     , CmapEncoding(..)
@@ -46,12 +48,13 @@ import Graphics.Fountainhead.Parser
     , parseTable
     , cmapTableP
     , headTableP
+    , hheaTableP
     )
-import Graphics.Fountainhead.Type (ttfEpoch)
+import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
 import Data.Foldable (Foldable(..))
 import Data.Maybe (fromMaybe)
 import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
-import Data.Bits (Bits(setBit))
+import Data.Bits (Bits(..))
 
 type ParseErrorOrDump
     = Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@@ -106,15 +109,38 @@ dumpOffsetTable directory
         <> justifyNumber 9 (getField @"length" table)
         <> newlineBuilder
 
+dumpFixed32 :: Fixed32 -> Text.Builder.Builder
+dumpFixed32 (Fixed32 word)
+    = Text.Builder.decimal (shiftR word 16)
+    <> Text.Builder.singleton '.'
+    <> Text.Builder.decimal (word .&. 0xff00)
+
+dumpHhea :: HheaTable -> Text.Builder.Builder
+dumpHhea HheaTable{..}
+    = dumpCaption "'hhea' Table - Font Header"
+    <> "         'hhea' version:         " <> dumpFixed32 version <> newlineBuilder
+    <> "         yAscender:              " <> Text.Builder.decimal ascent <> newlineBuilder
+    <> "         yDescender:             " <> Text.Builder.decimal descent <> newlineBuilder
+    <> "         yLineGap:               " <> Text.Builder.decimal lineGap <> newlineBuilder
+    <> "         advanceWidthMax:        " <> Text.Builder.decimal advanceWidthMax <> newlineBuilder
+    <> "         minLeftSideBearing:     " <> Text.Builder.decimal minLeftSideBearing <> newlineBuilder
+    <> "         minRightSideBearing:    " <> Text.Builder.decimal minRightSideBearing <> newlineBuilder
+    <> "         xMaxExtent:             " <> Text.Builder.decimal xMaxExtent <> newlineBuilder
+    <> "         caretSlopeRise:         " <> Text.Builder.decimal caretSlopeRise <> newlineBuilder
+    <> "         caretSlopeRun:          " <> Text.Builder.decimal caretSlopeRun <> newlineBuilder
+    <> "         reserved0:              0" <> newlineBuilder
+    <> "         reserved1:              0" <> newlineBuilder
+    <> "         reserved2:              0" <> newlineBuilder
+    <> "         reserved3:              0" <> newlineBuilder
+    <> "         reserved4:              0" <> newlineBuilder
+    <> "         metricDataFormat:       " <> Text.Builder.decimal metricDataFormat <> newlineBuilder
+    <> "         numberOfHMetrics:       " <> Text.Builder.decimal numOfLongHorMetrics <> newlineBuilder
+
 dumpHead :: HeadTable -> Text.Builder.Builder
 dumpHead HeadTable{..}
     = dumpCaption "'head' Table - Font Header"
-    {- version
+    <> "         head version:           " <> dumpFixed32 version <> newlineBuilder
-    <> lowestRecPPEM
+    <> "         fontRevision:           " <> dumpFixed32 fontRevision <> newlineBuilder
-    <> indexToLocFormat
-    <> glyphDataFormat
-    <> fontRevision
-    <> fontDirectionHint -}
     <> "         checkSumAdjustment:     " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
     <> "         magicNumber:            " <> paddedHexadecimal magicNumber <> newlineBuilder
     <> "         flags:                  0x" <> halfPaddedHexadecimal flags <> newlineBuilder
@@ -126,10 +152,22 @@ dumpHead HeadTable{..}
     <> "         xMax:                   " <> Text.Builder.decimal xMax <> newlineBuilder
     <> "         yMax:                   " <> Text.Builder.decimal yMax <> newlineBuilder
     <> "         macStyle bits:          " <> "0x" <> dumpFontStyle macStyle <> newlineBuilder
+    <> "         lowestRecPPEM           " <> Text.Builder.decimal lowestRecPPEM <> newlineBuilder
+    <> "         fontDirectionHint       " <> dumpFontDirectionHint fontDirectionHint <> newlineBuilder
+    <> "         indexToLocFormat        " <> Text.Builder.decimal indexToLocFormat <> newlineBuilder
+    <> "         glyphDataFormat         " <> Text.Builder.decimal glyphDataFormat <> newlineBuilder
+
+dumpFontDirectionHint :: FontDirectionHint -> Text.Builder.Builder
+dumpFontDirectionHint = \case
+    MixedDirectionalGlyphs -> "0"
+    StronglyLeftToRightGlyphs -> "1"
+    LeftToRightGlyphsWithNeutrals -> "2"
+    StronglyRightToLeftGlyphs -> "-1"
+    RightToLeftGlyphsWithNeutrals -> "-2"
 
 dumpFontStyle :: FontStyle -> Text.Builder.Builder
 dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
-    $ foldr (go . fst) (0 :: Int)
+    $ foldr (go . fst) (zeroBits :: Int)
     $ filter snd
     $ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
   where
@@ -257,6 +295,7 @@ dumpTables processedState directory@FontDirectory{..}
         case getField @"tag" tableEntry of
             "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
             "head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState
+            "hhea" -> Just $ dumpHhea <$> parseTable tableEntry hheaTableP processedState
             _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump

src/Graphics/Fountainhead/Parser.hs

@@ -38,7 +38,7 @@ module Graphics.Fountainhead.Parser
     ) where
 
 import Control.Applicative (Alternative(..))
-import Control.Monad (foldM)
+import Control.Monad (foldM, void)
 import Data.Bits (Bits(..))
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
@@ -260,9 +260,9 @@ hheaTableP = HheaTable
     <*> Megaparsec.Binary.int16be
     <*> Megaparsec.Binary.int16be
     <*> Megaparsec.Binary.word16be
-    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
-    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
-    <*> Megaparsec.Binary.word16be
+    <*> Megaparsec.Binary.int16be
     <*> Megaparsec.Binary.int16be
     <*> Megaparsec.Binary.int16be
     <*> Megaparsec.Binary.int16be
@@ -423,12 +423,13 @@ deviceRecordP size = do
 
 hdmxTableP :: Parser HdmxTable
 hdmxTableP = do
-    Megaparsec.chunk $ ByteString.pack [0, 0]
+    void $ Megaparsec.chunk $ ByteString.pack [0, 0]
     numberOfDeviceRecords <- fromIntegral <$> Megaparsec.Binary.int16be
     sizeOfDeviceRecord <- fromIntegral <$> Megaparsec.Binary.int32be
     records' <- Megaparsec.count numberOfDeviceRecords
         $ deviceRecordP sizeOfDeviceRecord
-    Megaparsec.eof >> pure (HdmxTable 0 records')
+    Megaparsec.eof
+    pure $ HdmxTable 0 records'
 
 -- * Glyph outline table
 

src/Graphics/Fountainhead/TrueType.hs

@@ -86,7 +86,7 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Time (LocalTime(..))
 import Data.Vector (Vector)
 import Data.Word (Word8, Word16, Word32)
-import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..))
+import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..), FWord, UFWord)
 
 -- * Font directory
 
@@ -164,16 +164,16 @@ data MaxpTable = OpenMaxp OpenMaxpTable | TrueMaxp TrueMaxpTable
 
 data HheaTable = HheaTable
     { version :: Fixed32 -- ^ 0x00010000 (1.0).
-    , ascent :: Int16 -- ^ Distance from baseline of highest ascender.
+    , ascent :: FWord -- ^ Distance from baseline of highest ascender.
-    , descent :: Int16 -- ^ Distance from baseline of lowest descender.
+    , descent :: FWord -- ^ Distance from baseline of lowest descender.
-    , lineGap :: Int16 -- ^ Typographic line gap.
+    , lineGap :: FWord -- ^ Typographic line gap.
-    , advanceWidthMax :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , advanceWidthMax :: UFWord -- ^ Must be consistent with horizontal metrics.
-    , minLeftSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , minLeftSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
-    , minRightSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
+    , minRightSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
-    , xMaxExtent :: Word16 -- ^ max(lsb + (xMax-xMin)).
+    , xMaxExtent :: FWord -- ^ max(lsb + (xMax-xMin)).
     , caretSlopeRise :: Int16 -- ^ used to calculate the slope of the caret (rise/run) set to 1 for vertical caret.
     , caretSlopeRun :: Int16 -- ^ 0 for vertical.
-    , caretOffset :: Int16 -- ^ Set value to 0 for non-slanted fonts.
+    , caretOffset :: FWord -- ^ Set value to 0 for non-slanted fonts.
     , metricDataFormat :: Int16 -- ^ 0 for current format.
     , numOfLongHorMetrics :: Word16 -- ^ Number of advance widths in metrics table.
     } deriving (Eq, Show)

src/Graphics/Fountainhead/Type.hs

@@ -6,11 +6,13 @@
 module Graphics.Fountainhead.Type
     ( F2Dot14(..)
     , Fixed32(..)
+    , FWord
+    , UFWord
     , ttfEpoch
     ) where
 
 import Data.Int (Int16)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
 import Data.Time (Day(..))
 import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
 
@@ -20,5 +22,8 @@ newtype Fixed32 = Fixed32 Word32
 newtype F2Dot14 = F2Dot14 Int16
     deriving (Eq, Show)
 
+type FWord = Int16
+type UFWord = Word16
+
 ttfEpoch :: Day
 ttfEpoch = fromOrdinalDate 1904 1