4 files changed, 44 insertions(+), 12 deletions(-)

M cbits/fontconfig-wrap.c
M cbits/transcode.c
M cbits/transcode.h
M lib/Graphics/Text/Font/Choose/Internal/FFI.hs

@@ 110,6 110,7 @@ uint8_t *fcFontSetList(FcConfig *config, uint8_t *sets, size_t sets_length,
     if (objs == NULL) goto fail_objs;
 
     FcFontSet *res = FcFontSetList(config, fontsets, nsets, pattern, objs);
+    if (res == NULL) goto fail_list;
 
     cmp_ctx_t out;
     if (!cmp_bytes_alloc(&out, 1024)) goto fail;


@@ 119,6 120,7 @@ uint8_t *fcFontSetList(FcConfig *config, uint8_t *sets, size_t sets_length,
 
 fail:
     FcFontSetDestroy(res);
+fail_list:
     FcObjectSetDestroy(objs);
 fail_objs:
     FcPatternDestroy(pattern);


@@ 147,13 149,14 @@ uint8_t *fcFontSetMatch(FcConfig *config, uint8_t *sets, size_t sets_length,
     cmp_bytes_take(&in, NULL);
     if (pattern == NULL) goto fail;
 
-    // Necessary preprocessing!
+    // Necessary preprocessing! Fold it into this C call, safer & *might* save overhead.
     FcPattern *res = NULL;
     if (!FcConfigSubstitute(config, pattern, FcMatchPattern)) goto fail2;
     FcDefaultSubstitute(pattern);
 
     FcResult err;
     res = FcFontSetMatch(config, fontsets, nsets, pattern, &err);
+    if (res == NULL) goto fail2;
 
     cmp_ctx_t out;
     bool ok;


@@ 194,13 197,14 @@ uint8_t *fcFontSetSort(FcConfig *config, uint8_t *sets, size_t sets_length,
     cmp_bytes_take(&in, NULL);
     if (pattern == NULL) goto fail;
 
-    // Necessary preprocessing!
+    // Necessary preprocessing! Fold into this C call, safer & *might* save overhead.
     if (!FcConfigSubstitute(config, pattern, FcMatchPattern)) goto fail2;
     FcDefaultSubstitute(pattern);
 
     FcResult err;
     FcCharSet *charset = NULL;
     FcFontSet *res = FcFontSetSort(config, fontsets, nsets, pattern, trim, &charset, &err);
+    if (res == NULL) goto fail2;
 
     cmp_ctx_t out;
     bool ok = true;


@@ 210,8 214,7 @@ uint8_t *fcFontSetSort(FcConfig *config, uint8_t *sets, size_t sets_length,
         ok = ok || cmp_write_array(&out, 2);
         if (res == NULL) cmp_write_nil(&out);
         else {
-            // FIXME: Postprocess each font! Rather than call encodeFontSet!
-            ok = ok || encodeFontSet(&out, res);
+            ok = ok || encodeRenderableFontSet(&out, res);
         }
         if (charset == NULL) cmp_write_nil(&out);
         else ok = ok || encodeCharSet(&out, charset);

@@ 406,6 406,21 @@ bool encodeFontSet(cmp_ctx_t *bytes, FcFontSet *data) {
     return true;
 }
 
+bool encodeRenderableFontSet(cmp_ctx_t *bytes, FcConfig *conf, FcPattern *pat, FcFontSet *data) {
+    if (bytes == NULL || data == NULL) return false;
+
+    if (!cmp_write_array(bytes, data->nfont)) return false;
+    for (int i = 0; i < data->nfont; i++) {
+        FcPattern *postprocessed = FcFontRenderPrepare(conf, pat, data->fonts[i]);
+        if (postprocessed == NULL) return false;
+
+        bool ok = encodePattern(bytes, postprocessed);
+        FcPatternDestroy(postprocessed);
+        if (!ok) return false;
+    }
+    return true;
+}
+
 bool encodeResult(cmp_ctx_t *bytes, FcResult res) {
     switch (res) {
     case FcResultMatch: // Should be handled by caller! Can't do anything sensible here.


@@ 432,7 447,7 @@ struct bytes {
 bool bytes_reader(struct cmp_ctx_s *ctx, void *data, size_t limit) {
     struct bytes *bytes = ctx->buf;
     if (bytes->offset + limit > bytes->length) return false;
-    data = bytes->start + bytes->offset;
+    memcpy(data, bytes->start + bytes->offset, limit);
     bytes->offset += limit;
     return true;
 }

@@ 21,6 21,7 @@ bool encodePattern(cmp_ctx_t *bytes, FcPattern *data);
 FcFontSet *decodeFontSet(cmp_ctx_t *bytes);
 FcFontSet **decodeFontSets(cmp_ctx_t *bytes, size_t *nsets);
 bool encodeFontSet(cmp_ctx_t *bytes, FcFontSet *data);
+bool encodeRenderableFontSet(cmp_ctx_t *bytes, FcFontSet *data);
 bool encodeResult(cmp_ctx_t *bytes, FcResult res);
 
 bool cmp_bytes_init(cmp_ctx_t *ctx, uint8_t *buf, size_t length);

@@ 1,19 1,29 @@
 module Graphics.Text.Font.Choose.Internal.FFI where
 
-import Data.MessagePack (MessagePack, pack, unpack)
+import Data.MessagePack (MessagePack(fromObject), pack, unpack, Object(ObjectStr))
 import Foreign.C.String (CString, withCString, peekCString)
 import Foreign.Ptr (Ptr)
 import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
 import Foreign.Storable (Storable(..))
-import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Alloc (alloca, free)
 import Data.Tuple (swap)
-import Graphics.Text.Font.Choose.Result (throwNull)
+import Graphics.Text.Font.Choose.Result (throwNull, FcException)
 import Data.Maybe (fromJust)
+import Text.Read (readMaybe)
+import Control.Exception (throw)
 
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackMallocCStringLen)
-import Data.ByteString.Lazy (toStrict, fromStrict)
+import Data.ByteString.Lazy (toStrict, fromStrict, ByteString)
+import qualified Data.Text as Txt
 import System.IO.Unsafe (unsafePerformIO)
 
+unpackWithErr :: MessagePack a => ByteString -> Maybe a
+unpackWithErr bs = case unpack bs of
+    Just (ObjectStr err) |
+        Just x <- (readMaybe $ Txt.unpack err :: Maybe FcException) -> throw x
+    Just x -> fromObject x
+    Nothing -> Nothing
+
 withMessageIO :: MessagePack a => (CString -> Int -> IO b) -> a -> IO b
 withMessageIO cb a = unsafeUseAsCStringLen (toStrict $ pack a) (uncurry cb)
 


@@ 21,7 31,7 @@ withMessage :: MessagePack a => (CString -> Int -> b) -> a -> b
 withMessage inner arg = unsafePerformIO $ withMessageIO (\x -> return . inner x) arg
 
 fromMessage :: MessagePack a => (Ptr Int -> CString) -> Maybe a
-fromMessage inner = unpack $ fromStrict $ unsafePerformIO $ do
+fromMessage inner = unpackWithErr $ fromStrict $ unsafePerformIO $ do
     unsafePackMallocCStringLen . swap =<< withPtr (throwNull . inner)
 
 fromMessage0 :: MessagePack a => (Ptr Int -> CString) -> a


@@ 32,7 42,7 @@ fromMessageIO inner = do
     (a, b) <- withPtr $ \ptr -> do
         throwNull =<< inner ptr
     bs <- unsafePackMallocCStringLen (b, a)
-    return $ unpack $ fromStrict bs
+    return $ unpackWithErr $ fromStrict bs
 
 fromMessageIO0 :: MessagePack a => (Ptr Int -> IO CString) -> IO a
 fromMessageIO0 inner = fromJust <$> fromMessageIO inner


@@ 41,7 51,10 @@ withCString' :: (CString -> a) -> String -> a
 withCString' inner = unsafePerformIO . flip withCString (return . inner)
 
 peekCString' :: CString -> String
-peekCString' = unsafePerformIO . peekCString
+peekCString' ptr = unsafePerformIO $ do
+    ret <- peekCString ptr
+    free ptr
+    return ret
 
 withForeignPtr' :: (Ptr a -> b) -> ForeignPtr a -> b
 withForeignPtr' inner arg = unsafePerformIO $ withForeignPtr arg $ return . inner