diff options
| author | Eugen Wissner <belka@caraus.de> | 2024-02-03 11:58:47 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2024-02-03 11:58:47 +0100 |
| commit | a34b46e1b553623d5dc385fc8e235df808fbadb2 (patch) | |
| tree | 7035a9625532bf6f7f41962c4352ac2367d065f3 /src/Graphics/Fountainhead.hs | |
| parent | 34d3ece99e438e5e81f4df6ca7a36de307e41b3e (diff) | |
| download | fountainhead-a34b46e1b553623d5dc385fc8e235df808fbadb2.tar.gz | |
Add font compression
Diffstat (limited to 'src/Graphics/Fountainhead.hs')
| -rw-r--r-- | src/Graphics/Fountainhead.hs | 50 |
1 files changed, 0 insertions, 50 deletions
diff --git a/src/Graphics/Fountainhead.hs b/src/Graphics/Fountainhead.hs deleted file mode 100644 index f965680..0000000 --- a/src/Graphics/Fountainhead.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- 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 |
