Extract some convenience parsing functions
This commit is contained in:
@@ -11,37 +11,24 @@ module Graphics.Fountainhead
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Void (Void)
|
||||
import Graphics.Fountainhead.Dumper (dumpTable, dumpTables, DumpError(..))
|
||||
import Graphics.Fountainhead.Parser (ParseErrorBundle, fontDirectoryP)
|
||||
import Graphics.Fountainhead.Parser (ParseErrorBundle, parseFontDirectory)
|
||||
import Graphics.Fountainhead.TrueType (FontDirectory(..))
|
||||
import qualified Text.Megaparsec as Megaparsec
|
||||
import Text.Megaparsec (PosState(..), State(..))
|
||||
import Text.Megaparsec (State(..))
|
||||
import System.IO (IOMode(..), withBinaryFile)
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import Graphics.Fountainhead.Compression (hDecompress)
|
||||
|
||||
-- | Does initial parsing of the font at the given path and returns the font
|
||||
-- directory and parsing state that can be used to parse other tables in the
|
||||
-- font.
|
||||
parseFontDirectoryFromFile :: FilePath
|
||||
-> IO (State ByteString Void, Either ParseErrorBundle FontDirectory)
|
||||
parseFontDirectoryFromFile fontFile =
|
||||
withBinaryFile fontFile ReadMode withFontHandle
|
||||
where
|
||||
withFontHandle fontHandle = doParsing
|
||||
<$> hDecompress fontHandle
|
||||
doParsing ttfContents =
|
||||
let initialState = Megaparsec.State
|
||||
{ stateInput = ttfContents
|
||||
, stateOffset = 0
|
||||
, statePosState = Megaparsec.PosState
|
||||
{ pstateInput = ttfContents
|
||||
, pstateOffset = 0
|
||||
, pstateSourcePos = Megaparsec.initialPos fontFile
|
||||
, pstateTabWidth = Megaparsec.defaultTabWidth
|
||||
, pstateLinePrefix = ""
|
||||
}
|
||||
, stateParseErrors = []
|
||||
}
|
||||
in Megaparsec.runParser' fontDirectoryP initialState
|
||||
parseFontDirectoryFromFile fontFile = withBinaryFile fontFile ReadMode
|
||||
$ fmap (parseFontDirectory fontFile) . hDecompress
|
||||
|
||||
-- | Dumps the contents of the font in the file. If the table name is given,
|
||||
-- dumps only this one table.
|
||||
dumpFontFile :: FilePath -> Maybe String -> IO (Either DumpError Text.Builder.Builder)
|
||||
dumpFontFile fontFile tableName = do
|
||||
let dumpRequest = maybe dumpTables dumpTable tableName
|
||||
|
Reference in New Issue
Block a user