Dump CV table

This commit is contained in:
Eugen Wissner 2023-12-04 09:39:08 +01:00
parent ea7f729058
commit 0cda68e19b

View File

@ -29,7 +29,7 @@ module Graphics.Fountainhead.Dumper
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.Int (Int64)
import Data.Int (Int64, Int16)
import Data.Word (Word8, Word16, Word32)
import qualified Data.IntMap as IntMap
import qualified Data.Text as Text
@ -71,8 +71,10 @@ import Graphics.Fountainhead.TrueType
, Os2MicrosoftFields(..)
, Os2Version1Fields(..)
, Os2Version4Fields(..)
, Os2Version5Fields(..)
, Os2Table(..)
, Panose(..)
, CVTable(..)
)
import qualified Text.Megaparsec as Megaparsec
import Graphics.Fountainhead.Parser
@ -86,7 +88,7 @@ import Graphics.Fountainhead.Parser
, maxpTableP
, nameTableP
, os2TableP
, postTableP
, postTableP, cvTableP
)
import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..), find)
@ -249,6 +251,17 @@ longDateTime localTime = Text.Builder.fromLazyText
$ (truncate :: NominalDiffTime -> Int)
$ diffLocalTime localTime (LocalTime ttfEpoch midnight)
dumpCVTable :: CVTable -> Text.Builder.Builder
dumpCVTable (CVTable cvTable) = dumpCaption "'cvt ' Table - Control Value Table"
<> "Size = " <> Text.Builder.decimal (tableSize * 2)
<> " bytes, " <> Text.Builder.decimal tableSize <> " entries\n"
<> foldMap (uncurry go) (zip [0..] cvTable)
where
tableSize = Prelude.length cvTable
go :: Int -> Int16 -> Text.Builder.Builder
go index' entry = justifyNumber 13 index' <> ". "
<> Text.Builder.decimal entry <> newlineBuilder
dumpOs2 :: Os2Table -> Text.Builder.Builder
dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go
where
@ -263,13 +276,29 @@ dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go
<> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
Os2Version4 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
Os2Version5 baseFields msFields _ -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields
Os2Version5 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion5Fields extraFields
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)
<> " sxHeight: " <> Text.Builder.decimal sxHeight <> newlineBuilder
<> " sCapHeight: " <> Text.Builder.decimal sCapHeight <> newlineBuilder
<> " usDefaultChar: 0x" <> halfPaddedHexadecimal usDefaultChar <> newlineBuilder
<> " usBreakChar: 0x" <> halfPaddedHexadecimal usBreakChar <> newlineBuilder
<> " usMaxContext: " <> Text.Builder.decimal usMaxContext <> newlineBuilder
dumpVersion5Fields Os2Version5Fields{..}
= dumpVersion1Fields (Os2Version1Fields ulCodePageRange1 ulCodePageRange2)
<> " sxHeight: " <> Text.Builder.decimal sxHeight <> newlineBuilder
<> " sCapHeight: " <> Text.Builder.decimal sCapHeight <> newlineBuilder
<> " usDefaultChar: 0x" <> halfPaddedHexadecimal usDefaultChar <> newlineBuilder
<> " usBreakChar: 0x" <> halfPaddedHexadecimal usBreakChar <> newlineBuilder
<> " usMaxContext: " <> Text.Builder.decimal usMaxContext <> newlineBuilder
<> " usLowerOpticalPointSize: "
<> Text.Builder.decimal usLowerOpticalPointSize <> newlineBuilder
<> " usUpperOpticalPointSize: "
<> Text.Builder.decimal usUpperOpticalPointSize <> newlineBuilder
dumpMicrosoftFields Os2MicrosoftFields{..}
= " sTypoAscender: " <> Text.Builder.decimal sTypoAscender <> newlineBuilder
<> " sTypoDescender: " <> Text.Builder.decimal sTypoDescender <> newlineBuilder
@ -625,6 +654,7 @@ dumpTables processedState directory@FontDirectory{..}
"name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
"post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
"OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
"cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
_ -> Nothing
dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder