1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
-- | Convenience wrappers for working with font files.
module Graphics.Fountainhead
( dumpFontFile
, parseFontDirectoryFromFile
) where
import Data.ByteString (ByteString)
import Data.Void (Void)
import Graphics.Fountainhead.Dumper (dumpTables, DumpError(..))
import Graphics.Fountainhead.Parser (ParseErrorBundle, fontDirectoryP)
import Graphics.Fountainhead.TrueType (FontDirectory(..))
import qualified Text.Megaparsec as Megaparsec
import Text.Megaparsec (PosState(..), State(..))
import System.IO (IOMode(..), withBinaryFile)
import Data.Bifunctor (Bifunctor(..))
import qualified Data.Text.Lazy.Builder as Text.Builder
import Graphics.Fountainhead.Compression (hDecompress)
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
dumpFontFile :: FilePath -> IO (Either DumpError Text.Builder.Builder)
dumpFontFile fontFile = do
(processedState, initialResult) <- parseFontDirectoryFromFile fontFile
pure $ first DumpParseError initialResult >>= dumpTables processedState
|
