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