Dump cmap format 4 subtable summary

This commit is contained in:
Eugen Wissner 2023-11-13 19:18:33 +01:00
parent 6923bceaa5
commit db61d2e558
2 changed files with 36 additions and 3 deletions

View File

@ -41,6 +41,7 @@ library
time ^>= 1.12,
transformers ^>= 0.5,
vector ^>= 0.13.0
ghc-options: -Wall
executable fountainhead
import: dependencies

View File

@ -6,6 +6,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
-- | Outputs information about a font as text.
module Graphics.Fountainhead.Dumper
@ -22,13 +23,17 @@ import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
import qualified Data.Vector as Vector
import Data.Void
import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType
( CmapTable(..)
, FontDirectory(..)
, OffsetSubtable(..)
, TableDirectory(..), CmapEncoding (..)
, TableDirectory(..)
, CmapEncoding(..)
, CmapSubtable(..)
, CmapFormat4Table(..)
)
import qualified Text.Megaparsec as Megaparsec
import Graphics.Fountainhead.Parser
@ -72,7 +77,7 @@ dumpOffsetTable directory
<> newlineBuilder
<> dumpOffsetSummary (tableDirectory directory)
where
dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0..]
dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0 :: Int ..]
dumpOffsetRow (index, table) = justifyNumber 4 index
<> ". '"
<> Text.Builder.fromText (Text.decodeASCII $ tag table)
@ -92,8 +97,10 @@ dumpCmap CmapTable{..}
<> " number of subtables: " <> Text.Builder.decimal (Prelude.length subtables) <> newlineBuilder
<> newlineBuilder
<> snd (foldr dumpCmapEncoding (pred encodingsLength, "") encodings) <> newlineBuilder
<> snd (foldr dumpCmapSubTable (pred subTablesLength, "") subtables) <> newlineBuilder
where
encodingsLength = Prelude.length encodings
subTablesLength = IntMap.size subtables
dumpCmapEncoding CmapEncoding{..} (index, accumulator) =
let findSubTableIndex = Text.Builder.decimal
. Prelude.length
@ -105,6 +112,31 @@ dumpCmap CmapTable{..}
<> " SubTable: " <> findSubTableIndex subtables
<> ", Offset: " <> paddedHexadecimal offset <> newlineBuilder
in (pred index, summary <> newlineBuilder <> accumulator)
dumpCmapSubTable currentSubTable (index, accumulator) =
let contents = "SubTable " <> Text.Builder.decimal index
<> ". " <> dumpCmapSubTableFormat currentSubTable
in (pred index, contents <> accumulator)
dumpCmapSubTableFormat = \case
(CmapFormat0 _) -> "Format 0"
(CmapFormat2 _) -> "Format 2"
(CmapFormat4 CmapFormat4Table{..}) ->
"Format 4 - Segment mapping to delta values\n\
\ Length: 994\n\
\ Version: 0\n\
\ segCount: "
<> Text.Builder.decimal (Vector.length startCode)
<> newlineBuilder <> " searchRange: "
<> Text.Builder.decimal searchRange
<> newlineBuilder <> " entrySelector: "
<> Text.Builder.decimal entrySelector
<> newlineBuilder <> " rangeShift: "
<> Text.Builder.decimal (Vector.length startCode * 2 - fromIntegral searchRange)
(CmapFormat6 _) -> "Format 6"
(CmapFormat8 _) -> "Format 8"
(CmapFormat10 _) -> "Format 10"
(CmapFormat12 _) -> "Format 12"
(CmapFormat13 _) -> "Format 13"
(CmapFormat14 _) -> "Format 14"
dumpTables
:: Megaparsec.State ByteString Void
@ -114,7 +146,7 @@ dumpTables processedState directory@FontDirectory{..}
= foldr go (Right $ dumpOffsetTable directory) tableDirectory
where
go :: TableDirectory -> ParseErrorOrDump -> ParseErrorOrDump
go tableEntry (Left accumulator) = Left accumulator
go _ (Left accumulator) = Left accumulator
go tableEntry (Right accumulator)
= maybe (Right accumulator) (concatDump accumulator)
$ dumpSubTable tableEntry