Move ttf dumper to a module

This commit is contained in:
2023-11-11 10:57:43 +01:00
parent 16f9dc70d1
commit 1d4efb44bb
5 changed files with 122 additions and 44 deletions

View File

@ -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