Add a test program
This commit is contained in:
46
app/Main.hs
Normal file
46
app/Main.hs
Normal file
@ -0,0 +1,46 @@
|
||||
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)
|
||||
|
||||
fontMain :: IO ()
|
||||
fontMain = do
|
||||
fontFile <- head <$> getArgs
|
||||
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 = fontMain
|
Reference in New Issue
Block a user