diff --git a/app/Main.hs b/app/Main.hs index aee0fd4..89a8dcd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -15,6 +15,7 @@ import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text.Lazy.IO as Text.Lazy import qualified Data.Text.Encoding as Text import GHC.Records (HasField(..)) +import Graphics.Fountainhead.Dumper (dumpTrueType) -- TODO: kern table since format 1. -- For details on subtable format see examples in TrueType reference. import Graphics.Fountainhead.Parser @@ -50,49 +51,17 @@ fontMain fontFile = do } , stateParseErrors = [] } - (processedState, Right directory) = Megaparsec.runParser' fontDirectoryP initialState - - Text.Lazy.putStrLn $ Text.Builder.toLazyText $ dumpOffsetTable directory - {- print directory + (processedState, initialResult) = Megaparsec.runParser' fontDirectoryP initialState + + case initialResult >>= dumpTrueType processedState 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 - Left e -> putStr (Megaparsec.errorBundlePretty e) Right x -> print x -} -paddedHexadecimal :: Integral a => a -> Text.Builder.Builder -paddedHexadecimal = ("0x" <>) - . Text.Builder.fromLazyText - . Text.Lazy.justifyRight 8 '0' - . Text.Builder.toLazyText - . Text.Builder.hexadecimal - -justifyNumber :: Integral a => Int64 -> a -> Text.Builder.Builder -justifyNumber count = Text.Builder.fromLazyText - . Text.Lazy.justifyRight count ' ' - . Text.Builder.toLazyText - . Text.Builder.decimal - -dumpOffsetTable :: FontDirectory -> Text.Builder.Builder -dumpOffsetTable directory - = "Offset Table\n------------\n" - <> " sfnt version: 1.0\n number of tables: " - <> Text.Builder.decimal (numTables $ offsetSubtable directory) - <> Text.Builder.singleton '\n' - <> dumpOffsetSummary (tableDirectory directory) - where - dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0..] - dumpOffsetRow (index, table) = justifyNumber 4 index - <> ". '" - <> Text.Builder.fromText (Text.decodeASCII $ tag table) - <> "' - checksum = " - <> paddedHexadecimal (getField @"checkSum" table) - <> ", offset = " - <> paddedHexadecimal (getField @"offset" table) - <> ", len = " - <> justifyNumber 9 (getField @"length" table) - <> Text.Builder.singleton '\n' - main :: IO () main = do programArguments <- getArgs diff --git a/fountainhead.cabal b/fountainhead.cabal index ce06a61..2e1427c 100644 --- a/fountainhead.cabal +++ b/fountainhead.cabal @@ -19,8 +19,14 @@ extra-source-files: CHANGELOG.md README.txt +common dependencies + build-depends: + text ^>= 2.0 + library + import: dependencies exposed-modules: + Graphics.Fountainhead.Dumper Graphics.Fountainhead.Parser Graphics.Fountainhead.PDF Graphics.Fountainhead.Type @@ -37,15 +43,13 @@ library vector ^>= 0.13.0 executable fountainhead + import: dependencies main-is: Main.hs default-extensions: - OverloadedStrings NamedFieldPuns - DataKinds DuplicateRecordFields ExplicitForAll - TypeApplications build-depends: base, bytestring, @@ -53,7 +57,6 @@ executable fountainhead parser-combinators, vector, transformers, - text, time, megaparsec, fountainhead diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs new file mode 100644 index 0000000..379dcb0 --- /dev/null +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -0,0 +1,105 @@ +{- This Source Code Form is subject to the terms of the Mozilla Public License, + v. 2.0. If a copy of the MPL was not distributed with this file, You can + obtain one at https://mozilla.org/MPL/2.0/. -} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Outputs information about a font as text. +module Graphics.Fountainhead.Dumper + ( ParseErrorOrDump + , dumpCmap + , dumpTrueType + , dumpOffsetTable + ) where + +import Data.ByteString (ByteString) +import Data.Int (Int64) +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 Data.Void +import GHC.Records (HasField(..)) +import Graphics.Fountainhead.TrueType + ( CmapTable(..) + , FontDirectory(..) + , OffsetSubtable(..) + , TableDirectory(..) + ) +import qualified Text.Megaparsec as Megaparsec +import Graphics.Fountainhead.Parser + ( parseTable + , cmapTableP + ) + +type ParseErrorOrDump + = Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder + +paddedHexadecimal :: Integral a => a -> Text.Builder.Builder +paddedHexadecimal = ("0x" <>) + . Text.Builder.fromLazyText + . Text.Lazy.justifyRight 8 '0' + . Text.Builder.toLazyText + . Text.Builder.hexadecimal + +justifyNumber :: Integral a => Int64 -> a -> Text.Builder.Builder +justifyNumber count = Text.Builder.fromLazyText + . Text.Lazy.justifyRight count ' ' + . Text.Builder.toLazyText + . Text.Builder.decimal + +newlineBuilder :: Text.Builder.Builder +newlineBuilder = Text.Builder.singleton '\n' + +dumpHead :: String -> Text.Builder.Builder +dumpHead headline = Text.Builder.fromString headline + <> newlineBuilder + <> Text.Builder.fromLazyText (Text.Lazy.replicate headlineLength "-") + <> newlineBuilder + where + headlineLength = fromIntegral $ Prelude.length headline + +dumpOffsetTable :: FontDirectory -> Text.Builder.Builder +dumpOffsetTable directory + = dumpHead "Offset Table" + <> " sfnt version: 1.0\n number of tables: " + <> Text.Builder.decimal (numTables $ offsetSubtable directory) + <> newlineBuilder + <> dumpOffsetSummary (tableDirectory directory) + where + dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0..] + dumpOffsetRow (index, table) = justifyNumber 4 index + <> ". '" + <> Text.Builder.fromText (Text.decodeASCII $ tag table) + <> "' - checksum = " + <> paddedHexadecimal (getField @"checkSum" table) + <> ", offset = " + <> paddedHexadecimal (getField @"offset" table) + <> ", len = " + <> justifyNumber 9 (getField @"length" table) + <> newlineBuilder + +dumpCmap :: CmapTable -> Text.Builder.Builder +dumpCmap = const $ dumpHead "'cmap' Table - Character to Glyph Index Mapping Table" + +dumpTrueType + :: Megaparsec.State ByteString Void + -> FontDirectory + -> ParseErrorOrDump +dumpTrueType processedState directory@FontDirectory{..} + = foldr go (Right $ dumpOffsetTable directory) tableDirectory + where + go :: TableDirectory -> ParseErrorOrDump -> ParseErrorOrDump + go tableEntry (Left accumulator) = Left accumulator + go tableEntry (Right accumulator) + = maybe (Right accumulator) (concatDump accumulator) + $ dumpSubTable tableEntry + concatDump accumulator builderDump = ((accumulator <> newlineBuilder) <>) + <$> builderDump + dumpSubTable tableEntry = + case getField @"tag" tableEntry of + "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState + _ -> Nothing diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs index 6d2b900..ea809d2 100644 --- a/src/Graphics/Fountainhead/Parser.hs +++ b/src/Graphics/Fountainhead/Parser.hs @@ -11,7 +11,8 @@ -- | Font parser. module Graphics.Fountainhead.Parser - ( cmapTableP + ( Parser + , cmapTableP , cvTableP , f2Dot14P , fixedP diff --git a/src/Graphics/Fountainhead/TrueType.hs b/src/Graphics/Fountainhead/TrueType.hs index a461d52..5b6eb68 100644 --- a/src/Graphics/Fountainhead/TrueType.hs +++ b/src/Graphics/Fountainhead/TrueType.hs @@ -751,7 +751,7 @@ data BXHeight -- * Kern table -data KernHeader = KernHeader +newtype KernHeader = KernHeader { version :: Fixed32 -- ^ The version number of the kerning table (0x00010000 for the current version). } deriving (Eq, Show)