diff --git a/fountainhead.cabal b/fountainhead.cabal index 2e1427c..e02f11b 100644 --- a/fountainhead.cabal +++ b/fountainhead.cabal @@ -41,6 +41,7 @@ library time ^>= 1.12, transformers ^>= 0.5, vector ^>= 0.13.0 + ghc-options: -Wall executable fountainhead import: dependencies diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs index 7216f96..dfa760f 100644 --- a/src/Graphics/Fountainhead/Dumper.hs +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -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