summaryrefslogtreecommitdiff
path: root/src/Graphics/Fountainhead.hs
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-02-03 11:58:47 +0100
committerEugen Wissner <belka@caraus.de>2024-02-03 11:58:47 +0100
commita34b46e1b553623d5dc385fc8e235df808fbadb2 (patch)
tree7035a9625532bf6f7f41962c4352ac2367d065f3 /src/Graphics/Fountainhead.hs
parent34d3ece99e438e5e81f4df6ca7a36de307e41b3e (diff)
downloadfountainhead-a34b46e1b553623d5dc385fc8e235df808fbadb2.tar.gz
Add font compression
Diffstat (limited to 'src/Graphics/Fountainhead.hs')
-rw-r--r--src/Graphics/Fountainhead.hs50
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