diff --git a/app/Main.hs b/app/Main.hs index 89a8dcd..c2c9787 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -38,29 +38,10 @@ fontMain fontFile = do putStrLn $ "Dumping File:" <> fontFile <> "\n\n" ttfContents <- ByteString.readFile 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 - case initialResult >>= dumpTrueType processedState of + case dumpTrueType ttfContents fontFile of (Right fontDump) -> Text.Lazy.putStrLn $ Text.Builder.toLazyText fontDump Left e -> putStr (Megaparsec.errorBundlePretty e) - {- - let Just tableDirectory' = find (("OS/2" ==) . tag) $ tableDirectory directory - tableResult = parseTable tableDirectory' os2TableP processedState - case tableResult of - Right x -> print x -} main :: IO () main = do 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