diff options
Diffstat (limited to 'src/Graphics')
| -rw-r--r-- | src/Graphics/Fountainhead/Dumper.hs | 49 |
1 files changed, 44 insertions, 5 deletions
diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs index 379dcb0..7216f96 100644 --- a/src/Graphics/Fountainhead/Dumper.hs +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -17,6 +17,7 @@ module Graphics.Fountainhead.Dumper import Data.ByteString (ByteString) import Data.Int (Int64) +import qualified Data.IntMap as IntMap import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text.Lazy.Builder as Text.Builder @@ -27,11 +28,12 @@ import Graphics.Fountainhead.TrueType ( CmapTable(..) , FontDirectory(..) , OffsetSubtable(..) - , TableDirectory(..) + , TableDirectory(..), CmapEncoding (..) ) import qualified Text.Megaparsec as Megaparsec import Graphics.Fountainhead.Parser - ( parseTable + ( fontDirectoryP + , parseTable , cmapTableP ) @@ -83,13 +85,32 @@ dumpOffsetTable directory <> newlineBuilder dumpCmap :: CmapTable -> Text.Builder.Builder -dumpCmap = const $ dumpHead "'cmap' Table - Character to Glyph Index Mapping Table" +dumpCmap CmapTable{..} + = dumpHead "'cmap' Table - Character to Glyph Index Mapping Table" + <> " 'cmap' version: " <> Text.Builder.decimal version <> newlineBuilder + <> " number of encodings: " <> Text.Builder.decimal encodingsLength <> newlineBuilder + <> " number of subtables: " <> Text.Builder.decimal (Prelude.length subtables) <> newlineBuilder + <> newlineBuilder + <> snd (foldr dumpCmapEncoding (pred encodingsLength, "") encodings) <> newlineBuilder + where + encodingsLength = Prelude.length encodings + dumpCmapEncoding CmapEncoding{..} (index, accumulator) = + let findSubTableIndex = Text.Builder.decimal + . Prelude.length + . filter ((< offset) . fromIntegral) + . IntMap.keys + summary = "Encoding " <> Text.Builder.decimal index + <> ". PlatformID: " <> Text.Builder.decimal platformID <> newlineBuilder + <> " EcodingID: " <> Text.Builder.decimal platformSpecificID <> newlineBuilder + <> " SubTable: " <> findSubTableIndex subtables + <> ", Offset: " <> paddedHexadecimal offset <> newlineBuilder + in (pred index, summary <> newlineBuilder <> accumulator) -dumpTrueType +dumpTables :: Megaparsec.State ByteString Void -> FontDirectory -> ParseErrorOrDump -dumpTrueType processedState directory@FontDirectory{..} +dumpTables processedState directory@FontDirectory{..} = foldr go (Right $ dumpOffsetTable directory) tableDirectory where go :: TableDirectory -> ParseErrorOrDump -> ParseErrorOrDump @@ -103,3 +124,21 @@ dumpTrueType processedState directory@FontDirectory{..} case getField @"tag" tableEntry of "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState _ -> Nothing + +dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump +dumpTrueType ttfContents fontFile = + let initialState = Megaparsec.State + { stateInput = ttfContents + , stateOffset = 0 + , statePosState = Megaparsec.PosState + { pstateInput = ttfContents + , pstateOffset = 0 + , pstateSourcePos = Megaparsec.initialPos fontFile + , pstateTabWidth = Megaparsec.defaultTabWidth + , pstateLinePrefix = "" + } + , stateParseErrors = [] + } + (processedState, initialResult) = Megaparsec.runParser' fontDirectoryP initialState + + in initialResult >>= dumpTables processedState |