Dump the offset subtable

This commit is contained in:
Eugen Wissner 2023-11-10 16:45:45 +01:00
parent 82ecf51fea
commit 16f9dc70d1

View File

@ -2,10 +2,19 @@ module Main
( main
) where
import Control.Monad (foldM_)
import Data.Int (Int64)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.ByteString (ByteString)
import qualified Text.Megaparsec as Megaparsec
import Data.Foldable (find)
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
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(..))
-- TODO: kern table since format 1.
-- For details on subtable format see examples in TrueType reference.
import Graphics.Fountainhead.Parser
@ -14,13 +23,19 @@ import Graphics.Fountainhead.Parser
, parseTable
, shortLocaTableP
)
import Graphics.Fountainhead.TrueType (FontDirectory(..), TableDirectory(..))
import Graphics.Fountainhead.TrueType
( FontDirectory(..)
, OffsetSubtable(..)
, TableDirectory(..)
)
import System.Environment (getArgs)
import System.Exit (exitWith)
import GHC.IO.Exception (ExitCode(..))
fontMain :: FilePath -> IO ()
fontMain fontFile = do
putStrLn $ "Dumping File:" <> fontFile <> "\n\n"
ttfContents <- ByteString.readFile fontFile
let initialState = Megaparsec.State
@ -36,12 +51,47 @@ fontMain fontFile = do
, stateParseErrors = []
}
(processedState, Right directory) = Megaparsec.runParser' fontDirectoryP initialState
print directory
Text.Lazy.putStrLn $ Text.Builder.toLazyText $ dumpOffsetTable directory
{- print directory
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
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