From ea7f729058a6dccb966a4a3e05bacdf7d7c46c86 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 3 Dec 2023 08:17:05 +0100
Subject: [PATCH] Dump OS/2 microsoft fields

---
 src/Graphics/Fountainhead/Dumper.hs | 41 ++++++++++++++++++++++++-----
 1 file changed, 35 insertions(+), 6 deletions(-)

diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index 8c99fc7..5384dba 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -68,6 +68,9 @@ import Graphics.Fountainhead.TrueType
     , TrueMaxpTable(..)
     , nameStringOffset
     , Os2BaseFields(..)
+    , Os2MicrosoftFields(..)
+    , Os2Version1Fields(..)
+    , Os2Version4Fields(..)
     , Os2Table(..)
     , Panose(..)
     )
@@ -250,12 +253,29 @@ 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
+        Os2Version0 baseFields msFields -> dumpBaseFields baseFields
+            <> maybe "" dumpMicrosoftFields msFields
+        Os2Version1 baseFields msFields extraFields -> dumpBaseFields baseFields
+            <> dumpMicrosoftFields msFields <> dumpVersion1Fields extraFields
+        Os2Version2 baseFields msFields extraFields -> dumpBaseFields baseFields
+            <> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
+        Os2Version3 baseFields msFields extraFields -> dumpBaseFields baseFields
+            <> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
+        Os2Version4 baseFields msFields extraFields -> dumpBaseFields baseFields
+            <> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
+        Os2Version5 baseFields msFields _ -> dumpBaseFields baseFields
+            <> dumpMicrosoftFields msFields
+    dumpVersion1Fields Os2Version1Fields{..}
+        = "         CodePage Range 1( Bits 0 - 31 ):        " <> paddedHexadecimal ulCodePageRange1 <> newlineBuilder
+        <> "         CodePage Range 2( Bits 32- 63 ):        " <> paddedHexadecimal ulCodePageRange2 <> newlineBuilder
+    dumpVersion4Fields Os2Version4Fields{..}
+        = dumpVersion1Fields (Os2Version1Fields ulCodePageRange1 ulCodePageRange2)
+    dumpMicrosoftFields Os2MicrosoftFields{..}
+        = "         sTypoAscender:          " <> Text.Builder.decimal sTypoAscender <> newlineBuilder
+        <> "         sTypoDescender:         " <> Text.Builder.decimal sTypoDescender <> newlineBuilder
+        <> "         sTypoLineGap:           " <> Text.Builder.decimal sTypoLineGap <> newlineBuilder
+        <> "         usWinAscent:            " <> Text.Builder.decimal usWinAscent <> newlineBuilder
+        <> "         usWinDescent:           " <> Text.Builder.decimal usWinDescent <> newlineBuilder
     dumpBaseFields Os2BaseFields{..}
         = "         'OS/2' version:         " <> Text.Builder.decimal version <> newlineBuilder
         <> "         xAvgCharWidth:          " <> Text.Builder.decimal xAvgCharWidth <> newlineBuilder
@@ -276,6 +296,15 @@ dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go
         <> "         PANOSE:" <> newlineBuilder <> dumpPanose panose
         <> fold (Vector.imap dumpUnicodeRange  ulUnicodeRange)
         <> "         achVendID:              '" <> achVendID' achVendID <> "'\n"
+        <> "         fsSelection:            0x" <> fsSelection' fsSelection <> newlineBuilder
+        <> "         usFirstCharIndex:       0x" <> halfPaddedHexadecimal fsFirstCharIndex <> newlineBuilder
+        <> "         usLastCharIndex:        0x" <> halfPaddedHexadecimal fsLastCharIndex <> newlineBuilder
+    fsSelection' value =
+        let description = fold
+                [ if testBit value 0 then "Italic " else ""
+                , if testBit value 5 then "Bold " else ""
+                ]
+         in halfPaddedHexadecimal value <> "           '" <> description <> "'"
     achVendID' = Text.Builder.fromText . Text.decodeLatin1 . ByteString.pack . fmap fromIntegral . toList
     dumpUnicodeRange index value =
         let bits = index * 32