module Main ( main ) where import qualified Data.ByteString as ByteString import Data.ByteString (ByteString) import qualified Text.Megaparsec as Megaparsec import Data.Foldable (find) -- 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(..), TableDirectory(..)) import System.Environment (getArgs) import System.Exit (exitWith) import GHC.IO.Exception (ExitCode(..)) fontMain :: FilePath -> IO () fontMain fontFile = do 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, Right directory) = Megaparsec.runParser' fontDirectoryP initialState 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 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)