Add font compression

1 files changed, 41 insertions, 0 deletions

diff --git a/lib/Graphics/Fountainhead/Type.hs b/lib/Graphics/Fountainhead/Type.hs
new file mode 100644
index 0000000..e809d9c
--- /dev/null
+++ b/lib/Graphics/Fountainhead/Type.hs
@@ -0,0 +1,41 @@
+{- 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/. -}
+
+-- | Generic font types.
+module Graphics.Fountainhead.Type
+    ( F2Dot14(..)
+    , Fixed32(..)
+    , FWord
+    , UFWord
+    , fixed2Double
+    , succIntegral
+    , ttfEpoch
+    ) where
+
+import Data.Bits ((.>>.), (.&.))
+import Data.Int (Int16)
+import Data.Word (Word16, Word32)
+import Data.Time (Day(..))
+import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
+
+newtype Fixed32 = Fixed32 Word32
+    deriving (Eq, Show)
+
+newtype F2Dot14 = F2Dot14 Int16
+    deriving (Eq, Show)
+
+type FWord = Int16
+type UFWord = Word16
+
+ttfEpoch :: Day
+ttfEpoch = fromOrdinalDate 1904 1
+
+succIntegral :: Integral a => a -> Int
+succIntegral = succ . fromIntegral
+
+fixed2Double :: F2Dot14 -> Double
+fixed2Double (F2Dot14 fixed) =
+    let mantissa = realToFrac (fixed .>>. 14)
+        fraction = realToFrac (fixed .&. 0x3fff) / 16384.0
+     in mantissa + fraction