From a34b46e1b553623d5dc385fc8e235df808fbadb2 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sat, 3 Feb 2024 11:58:47 +0100
Subject: Add font compression

---
 lib/Graphics/Fountainhead/Type.hs | 41 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)
 create mode 100644 lib/Graphics/Fountainhead/Type.hs

(limited to 'lib/Graphics/Fountainhead/Type.hs')

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
-- 
cgit v1.2.3