Add font compression

lib/Graphics/Fountainhead/Compression.hs

@@ -0,0 +1,27 @@
+-- | Font compression and decompression.
+module Graphics.Fountainhead.Compression
+    ( compress
+    , hDecompress
+    ) where
+
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Codec.Compression.Zlib as Zlib
+import System.IO (Handle, SeekMode(..), hFileSize, hSeek)
+
+-- | Reads the font from a file handle decompressing it if needed.
+hDecompress :: Handle -> IO ByteString
+hDecompress 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
+
+compress :: ByteString -> ByteString
+compress = ByteString.Lazy.toStrict . Zlib.compress . ByteString.Lazy.fromStrict