diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs index cea7c9a..dc23b4a 100644 --- a/src/Graphics/Fountainhead/Dumper.hs +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -4,9 +4,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} -- | Outputs information about a font as text. module Graphics.Fountainhead.Dumper @@ -16,16 +17,19 @@ module Graphics.Fountainhead.Dumper , dumpHmtx , dumpHhea , dumpLoca + , dumpName , dumpMaxp , dumpTrueType , dumpOffsetTable ) where import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 import Data.Int (Int64) -import Data.Word (Word16, Word32) +import Data.Word (Word8, Word16, Word32) import qualified Data.IntMap as IntMap +import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text.Lazy.Builder as Text.Builder @@ -49,10 +53,13 @@ import Graphics.Fountainhead.TrueType , FontStyle(..) , LongHorMetric(..) , LocaTable(..) + , NameRecord (..) + , NameTable(..) , IndexToLocFormat(..) , OpenMaxpTable(..) , MaxpTable(..) , TrueMaxpTable(..) + , nameStringOffset ) import qualified Text.Megaparsec as Megaparsec import Graphics.Fountainhead.Parser @@ -63,7 +70,7 @@ import Graphics.Fountainhead.Parser , hheaTableP , hmtxTableP , locaTableP - , maxpTableP + , maxpTableP, nameTableP ) import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch) import Data.Foldable (Foldable(..), find) @@ -71,6 +78,7 @@ import Data.Maybe (fromMaybe) import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight) import Data.Bits (Bits(..)) import Data.Bifunctor (Bifunctor(first)) +import Data.List (intersperse) data DumpError = DumpParseError (Megaparsec.ParseErrorBundle ByteString Void) @@ -342,6 +350,48 @@ dumpLoca table = = " Idx " <> justifyNumber 6 index <> " -> GlyphOffset " <> paddedHexadecimal element <> newlineBuilder +dumpName :: NameTable -> Text.Builder.Builder +dumpName table'@NameTable{..} = dumpCaption "'name' Table - Naming Table" + <> " Format: " <> Text.Builder.decimal format <> newlineBuilder + <> " Number of Record: " <> Text.Builder.decimal (Prelude.length nameRecord) <> newlineBuilder + <> " Storage offset: " <> Text.Builder.decimal (nameStringOffset table') <> newlineBuilder + <> foldMap go (zip3 [0 :: Int ..] nameRecord variable) + where + go (index, NameRecord{ length = length', ..}, variable') + = "Name table " <> justifyNumber 3 index <> "." + <> " PlatformID: " <> Text.Builder.decimal platformID <> newlineBuilder + <> " EncodingID: " <> Text.Builder.decimal platformSpecificID <> newlineBuilder + <> " LanguageID: " <> Text.Builder.decimal languageID <> newlineBuilder + <> " NameID: " <> Text.Builder.decimal nameID <> newlineBuilder + <> " Length: " <> Text.Builder.decimal length' <> newlineBuilder + <> " Offset: " <> Text.Builder.decimal offset <> newlineBuilder + <> foldMap (" " <>) (dumpHexString $ ByteString.unpack variable') + +dumpHexString :: [Word8] -> [Text.Builder.Builder] +dumpHexString byteCodes + | null byteCodes = [dumpHexLine " > " byteCodes] + | Prelude.length byteCodes < 10 = [dumpHexLine " > " byteCodes] + | otherwise = dumpHexLine " > " byteCodes + : dumpHexString (drop 10 byteCodes) + where + dumpHexLine separator variable' = + let firstTen = take 10 variable' + digits = fold $ intersperse (Text.Builder.singleton ' ') $ hexByte <$> firstTen + printables = foldMap printableByte firstTen + in digits + <> Text.Builder.fromText (Text.replicate (10 - Prelude.length firstTen) " ") + <> separator + <> printables + <> newlineBuilder + hexByte = Text.Builder.fromLazyText + . Text.Lazy.justifyRight 2 '0' + . Text.Builder.toLazyText . Text.Builder.hexadecimal + printableByte :: Word8 -> Text.Builder.Builder + printableByte code + | code >= 0x20 + , code < 0x7f = Text.Builder.singleton $ toEnum $ fromIntegral code + | otherwise = Text.Builder.singleton '.' + dumpMaxp :: MaxpTable -> Text.Builder.Builder dumpMaxp (TrueMaxp TrueMaxpTable{..}) = dumpCaption "'maxp' Table - Maximum Profile" @@ -399,6 +449,7 @@ dumpTables processedState directory@FontDirectory{..} "loca" -> Just $ dumpLoca <$> parseTable tableEntry (locaTableP $ getField @"indexToLocFormat" headTable) processedState "maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState + "name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState _ -> Nothing dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder diff --git a/src/Graphics/Fountainhead/TrueType.hs b/src/Graphics/Fountainhead/TrueType.hs index 4043098..5de0918 100644 --- a/src/Graphics/Fountainhead/TrueType.hs +++ b/src/Graphics/Fountainhead/TrueType.hs @@ -3,6 +3,7 @@ obtain one at https://mozilla.org/MPL/2.0/. -} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} -- | Types representing a TrueType font. module Graphics.Fountainhead.TrueType @@ -78,6 +79,7 @@ module Graphics.Fountainhead.TrueType , UnicodeValueRange(..) , VariationSelectorMap , unLocaTable + , nameStringOffset ) where import Data.ByteString (ByteString) @@ -128,6 +130,12 @@ data NameRecord = NameRecord , offset :: Int -- ^ Offset. } deriving (Eq, Show) +nameStringOffset :: NameTable -> Word16 +nameStringOffset NameTable{..} = + let nameRecordSize = 12 + precedingFieldsSize = 2 * 3 + in nameRecordSize * fromIntegral (Prelude.length nameRecord) + precedingFieldsSize + -- * 'cvt ' table newtype CVTable = CVTable [Int16]