Dump common OS/2 table fields

1 files changed, 62 insertions, 1 deletions

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index 304960e..ff2f203 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -20,6 +20,7 @@ module Graphics.Fountainhead.Dumper
     , dumpLoca
     , dumpName
     , dumpMaxp
+    , dumpOs2
     , dumpPost
     , dumpTrueType
     , dumpOffsetTable
@@ -66,6 +67,8 @@ import Graphics.Fountainhead.TrueType
     , MaxpTable(..)
     , TrueMaxpTable(..)
     , nameStringOffset
+    , Os2BaseFields(..)
+    , Os2Table(..)
     )
 import qualified Text.Megaparsec as Megaparsec
 import Graphics.Fountainhead.Parser
@@ -78,13 +81,14 @@ import Graphics.Fountainhead.Parser
     , locaTableP
     , maxpTableP
     , nameTableP
+    , os2TableP
     , postTableP
     )
 import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
 import Data.Foldable (Foldable(..), find)
 import Data.Maybe (fromMaybe)
 import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
-import Data.Bits (Bits(..))
+import Data.Bits (Bits(..), (.>>.))
 import Data.Bifunctor (Bifunctor(first))
 import Data.List (intersperse)
 
@@ -241,6 +245,62 @@ longDateTime localTime = Text.Builder.fromLazyText
     $ (truncate :: NominalDiffTime -> Int)
     $ diffLocalTime localTime (LocalTime ttfEpoch midnight)
 
+dumpOs2 :: Os2Table -> Text.Builder.Builder
+dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go
+  where
+    go = \case
+        Os2Version0 baseFields _ -> dumpBaseFields baseFields
+        Os2Version1 baseFields _ _ -> dumpBaseFields baseFields
+        Os2Version2 baseFields _ _ -> dumpBaseFields baseFields
+        Os2Version3 baseFields _ _ -> dumpBaseFields baseFields
+        Os2Version4 baseFields _ _ -> dumpBaseFields baseFields
+        Os2Version5 baseFields _ _ -> dumpBaseFields baseFields
+    dumpBaseFields Os2BaseFields{..}
+        = "         'OS/2' version:         " <> Text.Builder.decimal version <> newlineBuilder
+        <> "         xAvgCharWidth:          " <> Text.Builder.decimal xAvgCharWidth <> newlineBuilder
+        <> "         usWeightClass:          " <> weightClass usWeightClass <> newlineBuilder
+        <> "         usWidthClass:           " <> widthClass usWidthClass <> newlineBuilder
+        <> "         fsType:                 " <> Text.Builder.decimal fsType <> newlineBuilder
+        <> "         ySubscriptXSize:        " <> Text.Builder.decimal ySubscriptXSize <> newlineBuilder
+        <> "         ySubscriptYSize:        " <> Text.Builder.decimal ySubscriptYSize <> newlineBuilder
+        <> "         ySubscriptXOffset:      " <> Text.Builder.decimal ySubscriptXOffset <> newlineBuilder
+        <> "         ySubscriptYOffset:      " <> Text.Builder.decimal ySubscriptYOffset <> newlineBuilder
+        <> "         ySuperscriptXSize:      " <> Text.Builder.decimal ySuperscriptXSize <> newlineBuilder
+        <> "         ySuperscriptYSize:      " <> Text.Builder.decimal ySuperscriptYSize <> newlineBuilder
+        <> "         ySuperscriptXOffset:    " <> Text.Builder.decimal ySuperscriptXOffset <> newlineBuilder
+        <> "         ySuperscriptYOffset:    " <> Text.Builder.decimal ySuperscriptYOffset <> newlineBuilder
+        <> "         yStrikeoutSize:         " <> Text.Builder.decimal yStrikeoutSize <> newlineBuilder
+        <> "         yStrikeoutPosition:     " <> Text.Builder.decimal yStrikeoutPosition <> newlineBuilder
+        <> "         sFamilyClass:" <> familyClass sFamilyClass
+    familyClass value =
+        "   " <> Text.Builder.decimal (value .>>. 8) <> "       subclass = " <> Text.Builder.decimal (value .&. 0x00ff)
+    weightClass classValue
+        | Just wordValue <- fWeight classValue = Text.Builder.decimal classValue <> "     '" <> wordValue <> "'"
+        | otherwise = Text.Builder.decimal classValue
+    widthClass classValue
+        | Just wordValue <- fWidth classValue = Text.Builder.decimal classValue <> "       '" <> wordValue <> "'"
+        | otherwise = Text.Builder.decimal classValue
+    fWeight 100 = Just "Thin"
+    fWeight 200 = Just "Extra-light"
+    fWeight 300 = Just "Light"
+    fWeight 400 = Just "Normal"
+    fWeight 500 = Just "Medium"
+    fWeight 600 = Just "Semi-bold"
+    fWeight 700 = Just "Bold"
+    fWeight 800 = Just "Extra-bold"
+    fWeight 900 = Just "Black"
+    fWeight _ = Nothing
+    fWidth 1 = Just "Ultra-condensed"
+    fWidth 2 = Just "Extra-condensed"
+    fWidth 3 = Just "Condensed"
+    fWidth 4 = Just "Semi-condensed"
+    fWidth 5 = Just "Medium"
+    fWidth 6 = Just "Semi-expanded"
+    fWidth 7 = Just "Expanded"
+    fWidth 8 = Just "Extra-expanded"
+    fWidth 9 = Just "Ultra-expanded"
+    fWidth _ = Nothing
+
 dumpPost :: PostTable -> Text.Builder.Builder
 dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable }
     = dumpCaption "'post' Table - PostScript" <> newlineBuilder
@@ -500,6 +560,7 @@ dumpTables processedState directory@FontDirectory{..}
             "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
             "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
             "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
+            "OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
             _ -> Nothing
 
 dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder