Dump the glyf table

This commit is contained in:
Eugen Wissner 2024-01-15 09:42:17 +01:00
parent 16d9fc384f
commit 1cce3c893d
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0

View File

@ -61,6 +61,10 @@ import Graphics.Fountainhead.TrueType
, CmapSubtable(..) , CmapSubtable(..)
, CmapFormat4Table(..) , CmapFormat4Table(..)
, FontStyle(..) , FontStyle(..)
, GlyphCoordinate(..)
, GlyphDefinition(..)
, GlyphDescription(..)
, GlyfTable(..)
, LongHorMetric(..) , LongHorMetric(..)
, LocaTable(..) , LocaTable(..)
, NameRecord (..) , NameRecord (..)
@ -77,6 +81,7 @@ import Graphics.Fountainhead.TrueType
, Os2Version5Fields(..) , Os2Version5Fields(..)
, Os2Table(..) , Os2Table(..)
, Panose(..) , Panose(..)
, SimpleGlyphDefinition(..)
, CVTable(..) , CVTable(..)
) )
import qualified Text.Megaparsec as Megaparsec import qualified Text.Megaparsec as Megaparsec
@ -94,6 +99,7 @@ import Graphics.Fountainhead.Parser
, os2TableP , os2TableP
, postTableP , postTableP
, cvTableP , cvTableP
, glyfTableP
) )
import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch) import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..), find) import Data.Foldable (Foldable(..), find)
@ -110,6 +116,7 @@ data DumpError
data RequiredTables = RequiredTables data RequiredTables = RequiredTables
{ hheaTable :: HheaTable { hheaTable :: HheaTable
, headTable :: HeadTable , headTable :: HeadTable
, locaTable :: LocaTable
} deriving (Eq, Show) } deriving (Eq, Show)
paddedHexadecimal :: Integral a => a -> Text.Builder.Builder paddedHexadecimal :: Integral a => a -> Text.Builder.Builder
@ -634,6 +641,37 @@ dumpGASP GASPTable{..} = dumpCaption "'gasp' Table - Grid-fitting And Scan-conve
<> " rangeMaxPPEM: " <> Text.Builder.decimal rangeMaxPPEM <> newlineBuilder <> " rangeMaxPPEM: " <> Text.Builder.decimal rangeMaxPPEM <> newlineBuilder
<> " rangeGaspBehavior: 0x" <> halfPaddedHexadecimal rangeGaspBehavior <> newlineBuilder <> " rangeGaspBehavior: 0x" <> halfPaddedHexadecimal rangeGaspBehavior <> newlineBuilder
dumpGlyf :: GlyfTable -> Text.Builder.Builder
dumpGlyf (GlyfTable glyfDescriptions) = dumpCaption "'glyf' Table - Glyf data"
<> foldMap go (Vector.indexed glyfDescriptions)
where
go (glyphIndex, GlyphDescription{..})
= "Glyph " <> justifyNumber 6 glyphIndex <> Text.Builder.singleton '.' <> newlineBuilder
<> " numberOfContours: " <> Text.Builder.decimal numberOfContours <> newlineBuilder
<> " xMin: " <> Text.Builder.decimal xMin <> newlineBuilder
<> " yMin: " <> Text.Builder.decimal yMin <> newlineBuilder
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> newlineBuilder <> dumpGlyphDefinition definition <> newlineBuilder
dumpEndPoint (endPointIndex, endPoint)
= " " <> justifyNumber 2 endPointIndex
<> ": " <> Text.Builder.decimal endPoint <> newlineBuilder
dumpGlyphDefinition (SimpleGlyph SimpleGlyphDefinition{..})
= " EndPoints" <> newlineBuilder
<> " ---------" <> newlineBuilder
<> foldMap dumpEndPoint (Vector.indexed endPtsOfContours) <> newlineBuilder
<> " Length of Instructions: "
<> Text.Builder.decimal (Vector.length instructions) <> newlineBuilder
<> " Flags" <> newlineBuilder
<> " -----" <> newlineBuilder
<> foldMap dumpFlag (Vector.indexed coordinates) <> newlineBuilder <> newlineBuilder
dumpGlyphDefinition _ = ""
dumpFlag (coordinateIndex, GlyphCoordinate{..})
= " " <> justifyNumber 2 coordinateIndex <> ": "
<> Text.Builder.decimal coordinateX <> " " <> Text.Builder.decimal coordinateY <> " "
<> (if onCurve then "On" else "Off")
<> newlineBuilder
dumpTables dumpTables
:: Megaparsec.State ByteString Void :: Megaparsec.State ByteString Void
-> FontDirectory -> FontDirectory
@ -644,9 +682,16 @@ dumpTables processedState directory@FontDirectory{..}
traverseDirectory parsedRequired = traverseDirectory parsedRequired =
let initial = Right $ dumpOffsetTable directory let initial = Right $ dumpOffsetTable directory
in foldl' (go parsedRequired) initial tableDirectory in foldl' (go parsedRequired) initial tableDirectory
parseRequired = RequiredTables parseRequired = do
<$> findRequired "hhea" hheaTableP requiredHhea <- findRequired "hhea" hheaTableP
<*> findRequired "head" headTableP requiredHead@HeadTable{ indexToLocFormat } <-
findRequired "head" headTableP
requiredLoca <- findRequired "loca" (locaTableP indexToLocFormat)
pure $ RequiredTables
{ hheaTable = requiredHhea
, headTable = requiredHead
, locaTable = requiredLoca
}
findRequired tableName parser = findRequired tableName parser =
let missingError = Left $ DumpRequiredTableMissingError tableName let missingError = Left $ DumpRequiredTableMissingError tableName
parseFound tableEntry = parseTable tableEntry parser processedState parseFound tableEntry = parseTable tableEntry parser processedState
@ -665,14 +710,14 @@ dumpTables processedState directory@FontDirectory{..}
"hhea" -> Just $ Right $ dumpHhea hheaTable "hhea" -> Just $ Right $ dumpHhea hheaTable
"hmtx" -> Just $ dumpHmtx "hmtx" -> Just $ dumpHmtx
<$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState <$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState
"loca" -> Just $ dumpLoca "loca" -> Just $ Right $ dumpLoca locaTable
<$> parseTable tableEntry (locaTableP $ getField @"indexToLocFormat" headTable) processedState
"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 "OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
"cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState "cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
"gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState "gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState
"glyf" -> Just $ dumpGlyf <$> parseTable tableEntry (glyfTableP locaTable) processedState
_ -> Nothing _ -> Nothing
dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder