diff --git a/app/Main.hs b/app/Main.hs index cc2c11d..aee0fd4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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