From 6982c3dd25fc94e0cf45e71a55e44e4db53bf452 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 18 Nov 2022 16:59:40 +1300
Subject: [PATCH] Commit moved FreeType integration module.

---
 FreeType/FontConfig.hs | 68 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 68 insertions(+)
 create mode 100644 FreeType/FontConfig.hs

diff --git a/FreeType/FontConfig.hs b/FreeType/FontConfig.hs
new file mode 100644
index 0000000..cadfaa0
--- /dev/null
+++ b/FreeType/FontConfig.hs
@@ -0,0 +1,68 @@
+-- NOTE: Not tested
+module FreeType.FontConfig (ftCharIndex, ftCharSet, ftCharSetAndSpacing,
+    ftQuery, ftQueryAll, ftQueryFace) where
+
+import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet_, thawCharSet, thawCharSet_)
+import Graphics.Text.Font.Choose.Pattern (Pattern, Pattern_, thawPattern, thawPattern_)
+import Graphics.Text.Font.Choose.FontSet (FontSet, FontSet_, withFontSet, thawFontSet)
+import FreeType.Core.Base (FT_Face(..))
+import Data.Word (Word32, Word)
+
+import Foreign.Ptr (nullPtr, Ptr)
+import Foreign.Storable (peek)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.C.String (CString, withCString)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Control.Exception (throw)
+import Graphics.Text.Font.Choose.Result (Error(ErrTypeMismatch))
+
+c2w :: Char -> Word32
+c2w = fromIntegral . fromEnum
+
+ftCharIndex :: FT_Face -> Char -> Word
+ftCharIndex face = fcFreeTypeCharIndex face . c2w
+foreign import ccall "FcFreeTypeCharIndex" fcFreeTypeCharIndex :: FT_Face -> Word32 -> Word
+
+ftCharSet :: FT_Face -> CharSet
+ftCharSet face = unsafePerformIO $ thawCharSet_ $ fcFreeTypeCharSet face nullPtr
+foreign import ccall "FcFreeTypeCharSet" fcFreeTypeCharSet
+    :: FT_Face -> Ptr () -> IO CharSet_ -- 2nd arg's deprecated!
+
+data Spacing = Proportional | Dual | Mono
+ftCharSetAndSpacing :: FT_Face -> (CharSet, Spacing)
+ftCharSetAndSpacing face = unsafePerformIO $ alloca $ \spacing' -> do
+    chars <- thawCharSet_ $ fcFreeTypeCharSetAndSpacing face nullPtr spacing'
+    spacing_ <- peek spacing'
+    let spacing = case spacing_ of{
+        0 -> Proportional;
+        90 -> Dual;
+        100 -> Mono;
+        _ -> throw ErrTypeMismatch}
+    return (chars, spacing)
+foreign import ccall "FcFreeTypeCharSetAndSpacing" fcFreeTypeCharSetAndSpacing ::
+    FT_Face -> Ptr () -> Ptr Int -> IO CharSet_ -- 2nd arg's deprecated!
+
+ftQuery :: FilePath -> Int -> IO (Pattern, Int)
+ftQuery filename id = withCString filename $ \filename' -> alloca $ \count' -> do
+    pattern <- thawPattern_ $ fcFreeTypeQuery filename' id nullPtr count'
+    count <- peek count'
+    return (pattern, count)
+foreign import ccall "FcFreeTypeQuery" fcFreeTypeQuery ::
+    CString -> Int -> Ptr () -> Ptr Int -> IO Pattern_ -- 3rd arg's deprecated!
+
+ftQueryAll :: FilePath -> Int -> IO (FontSet, Int)
+ftQueryAll filename id = withCString filename $ \filename' -> alloca $ \count' ->
+    withFontSet [] $ \fonts' -> do
+        fcFreeTypeQueryAll filename' id nullPtr count' fonts'
+        fonts <- thawFontSet fonts'
+        count <- peek count'
+        return (fonts, count)
+foreign import ccall "FcFreeTypeQueryAll" fcFreeTypeQueryAll ::
+    CString -> Int -> Ptr () -> Ptr Int -> FontSet_ -> IO Word -- 2nd arg's deprecated!
+
+ftQueryFace :: FT_Face -> FilePath -> Int -> IO Pattern
+ftQueryFace face filename id = withCString filename $ \filename' ->
+    thawPattern_ $ fcFreeTypeQueryFace face filename' id nullPtr
+foreign import ccall "FcFreeTypeQueryFace" fcFreeTypeQueryFace ::
+    FT_Face -> CString -> Int -> Ptr () -> IO Pattern_ -- Final arg's deprecated!
-- 
2.30.2