38 lines
1.4 KiB
Haskell
38 lines
1.4 KiB
Haskell
module Main
|
|
( main
|
|
) where
|
|
|
|
import Data.Bifunctor (Bifunctor(..))
|
|
import qualified Text.Megaparsec as Megaparsec
|
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
import qualified Data.Text.Lazy.IO as Text.Lazy
|
|
import Graphics.Fountainhead (parseFontDirectoryFromFile)
|
|
import Graphics.Fountainhead.Dumper (DumpError(..), dumpTables)
|
|
-- TODO: kern table since format 1.
|
|
-- For details on subtable format see examples in TrueType reference.
|
|
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")
|
|
|
|
(processedState, initialResult) <- parseFontDirectoryFromFile fontFile
|
|
|
|
case first DumpParseError initialResult >>= dumpTables processedState of
|
|
Right fontDump -> Text.Lazy.putStrLn $ Text.Builder.toLazyText fontDump
|
|
Left e
|
|
| DumpParseError bundle <- e -> putStr
|
|
$ Megaparsec.errorBundlePretty bundle
|
|
| DumpRequiredTableMissingError tableName <- e -> putStr
|
|
$ "Required table " <> tableName <> " is missing."
|
|
|
|
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)
|