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(..)) 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 ( fontDirectoryP , os2TableP , parseTable , shortLocaTableP ) 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 { stateInput = ttfContents , stateOffset = 0 , statePosState = Megaparsec.PosState { pstateInput = ttfContents , pstateOffset = 0 , pstateSourcePos = Megaparsec.initialPos fontFile , pstateTabWidth = Megaparsec.defaultTabWidth , pstateLinePrefix = "" } , stateParseErrors = [] } (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 Right x -> print x -} main :: IO () main = do programArguments <- getArgs case programArguments of [fontFile] -> fontMain fontFile _ -> putStrLn "The program expects exactly one argument, the font file path." >> exitWith (ExitFailure 2)