51 lines
2.2 KiB
Haskell
51 lines
2.2 KiB
Haskell
{- 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/. -}
|
|
|
|
module Graphics.Fountainhead
|
|
( parseFontDirectoryFromFile
|
|
) where
|
|
|
|
import qualified Codec.Compression.Zlib as Zlib
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as ByteString
|
|
import qualified Data.ByteString.Lazy as ByteString.Lazy
|
|
import Data.Void (Void)
|
|
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(..), SeekMode(..), hFileSize, hSeek, withBinaryFile)
|
|
|
|
parseFontDirectoryFromFile :: String
|
|
-> IO (State ByteString Void, Either ParseErrorBundle FontDirectory)
|
|
parseFontDirectoryFromFile fontFile =
|
|
withBinaryFile fontFile ReadMode withFontHandle
|
|
where
|
|
withFontHandle fontHandle = doParsing
|
|
<$> readFontContents 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
|
|
readFontContents fontHandle = do
|
|
firstBytes <- ByteString.unpack <$> ByteString.hGet fontHandle 2
|
|
hSeek fontHandle AbsoluteSeek 0
|
|
fileSize <- fromIntegral <$> hFileSize fontHandle
|
|
case firstBytes of
|
|
0x78 : [secondByte]
|
|
| secondByte `elem` [0x01, 0x9c, 0x5e, 0xda] ->
|
|
ByteString.Lazy.toStrict . Zlib.decompress
|
|
<$> ByteString.Lazy.hGet fontHandle fileSize
|
|
_ -> ByteString.hGetContents fontHandle
|