Dump common OS/2 table fields

This commit is contained in:
Eugen Wissner 2023-12-01 08:21:39 +01:00
parent 271b69839a
commit b0950899cc
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0

View File

@ -20,6 +20,7 @@ module Graphics.Fountainhead.Dumper
, dumpLoca , dumpLoca
, dumpName , dumpName
, dumpMaxp , dumpMaxp
, dumpOs2
, dumpPost , dumpPost
, dumpTrueType , dumpTrueType
, dumpOffsetTable , dumpOffsetTable
@ -66,6 +67,8 @@ import Graphics.Fountainhead.TrueType
, MaxpTable(..) , MaxpTable(..)
, TrueMaxpTable(..) , TrueMaxpTable(..)
, nameStringOffset , nameStringOffset
, Os2BaseFields(..)
, Os2Table(..)
) )
import qualified Text.Megaparsec as Megaparsec import qualified Text.Megaparsec as Megaparsec
import Graphics.Fountainhead.Parser import Graphics.Fountainhead.Parser
@ -78,13 +81,14 @@ import Graphics.Fountainhead.Parser
, locaTableP , locaTableP
, maxpTableP , maxpTableP
, nameTableP , nameTableP
, os2TableP
, postTableP , postTableP
) )
import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch) import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..), find) import Data.Foldable (Foldable(..), find)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight) import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
import Data.Bits (Bits(..)) import Data.Bits (Bits(..), (.>>.))
import Data.Bifunctor (Bifunctor(first)) import Data.Bifunctor (Bifunctor(first))
import Data.List (intersperse) import Data.List (intersperse)
@ -241,6 +245,62 @@ longDateTime localTime = Text.Builder.fromLazyText
$ (truncate :: NominalDiffTime -> Int) $ (truncate :: NominalDiffTime -> Int)
$ diffLocalTime localTime (LocalTime ttfEpoch midnight) $ 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 -> Text.Builder.Builder
dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable } dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable }
= dumpCaption "'post' Table - PostScript" <> newlineBuilder = dumpCaption "'post' Table - PostScript" <> newlineBuilder
@ -500,6 +560,7 @@ dumpTables processedState directory@FontDirectory{..}
"maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
"name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
"post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState "post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
"OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
_ -> Nothing _ -> Nothing
dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder