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
, 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