~alcinnz/fontconfig-pure

9aee49dd6084ce6deef6099a3b7c27fa0f6c8b1e — Adrian Cochrane 8 months ago bea597e
Finish initial redraft
M cbits/fontconfig-wrap.c => cbits/fontconfig-wrap.c +27 -7
@@ 363,6 363,29 @@ uint8_t *fcFreeTypeQueryFace(FT_Face *face, char *file, int id, size_t *length) 
    return ret;
}

int fcLangSetCompare(uint8_t *langset, size_t length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, langset, length)) return -1;
    uint32_t size = 0;
    if (!cmp_read_array(&in, &size) || size != 2) {cmp_bytes_take(&in, NULL); return -1;}
    FcLangSet *a = decodeLangSet(&in);
    if (a == NULL) {cmp_bytes_take(&in, NULL); return -1;}
    FcLangSet *b = decodeLangSet(&in);
    cmp_bytes_take(&in, NULL);
    if (b == NULL) return -1;

    FcLangResult ret = FcLangSetCompare(a, b);
    FcLangSetDestroy(a);
    FcLangSetDestroy(b);

    switch (ret) {
    case FcLangDifferentLang: return 0;
    case FcLangEqual: return 1;
    case FcLangDifferentTerritory: return 2;
    default: return -2;
    }
}

int fcLangSetHasLang(uint8_t *langset, size_t length, const char *lang) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, langset, length)) return -1;


@@ 508,20 531,16 @@ uint8_t *fcConfigGetCacheDirs(FcConfig *conf, size_t *length) {
}

uint8_t *fcConfigGetFonts(FcConfig *conf, bool system, size_t *length) {
    // NOTE: We shouldn't free results!
    FcFontSet *res = FcConfigGetFonts(conf, system ? FcSetSystem : FcSetApplication);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcFontSetDestroy(res);
        return NULL;
    }
    if (!cmp_bytes_alloc(&out, 1024)) return NULL;
    if (!encodeFontSet(&out, res)) {
        cmp_bytes_free(&out);
        FcFontSetDestroy(res);
        return NULL;
    }
    FcFontSetDestroy(res);
    return cmp_bytes_take(&out, length);
}



@@ 610,8 629,9 @@ uint8_t *fcFontSort(FcConfig *conf, uint8_t *data, size_t in_length, bool trim, 
        if (!encodeFontSet(&out, res)) goto fail3;
        if (!encodeCharSet(&out, csp)) goto fail3;
    } else {
        if (!cmp_write_array(&out, 1)) goto fail3;
        if (!cmp_write_array(&out, 2)) goto fail3;
        if (!encodeFontSet(&out, res)) goto fail3;
        if (!cmp_write_array(&out, 0)) goto fail3;
    }
    FcPatternDestroy(p);
    if (csp != NULL) FcCharSetDestroy(csp);

D cbits/fontconfig-wrap.c~ => cbits/fontconfig-wrap.c~ +0 -681
@@ 1,681 0,0 @@
#include "transcode.h"
#include <fontconfig/fontconfig.h>
#include <stdlib.h>
#include <fontconfig/fcfreetype.h>

int fcPatternEqualSubset(uint8_t *data, size_t length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, length)) return -1;
    uint32_t size = 0;
    if (!cmp_read_array(&in, &size) || size != 3) {
        cmp_bytes_take(&in, NULL);
        return -1;
    }
    FcPattern *pa = decodePattern(&in);
    if (pa == NULL) {cmp_bytes_take(&in, NULL); return -1;}
    FcPattern *pb = decodePattern(&in);
    if (pb == NULL) {
        cmp_bytes_take(&in, NULL);
        FcPatternDestroy(pa);
        return -1;
    }
    FcObjectSet *os = decodeObjectSet(&in);
    cmp_bytes_take(&in, NULL);

    int ret = -1;
    if (os != NULL) ret = FcPatternEqualSubset(pa, pb, os) ? 1 : 0;

    FcPatternDestroy(pa);
    FcPatternDestroy(pb);
    FcObjectSetDestroy(os);
    return ret;
}



uint8_t *fcNameParse(char *name, size_t *length) {
    FcPattern *pat = FcNameParse(name);
    if (pat == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {FcPatternDestroy(pat); return NULL;}
    if (!encodePattern(&out, pat)) {
        FcPatternDestroy(pat); cmp_bytes_free(&out); return NULL;
    }
    FcPatternDestroy(pat);
    return cmp_bytes_take(&out, length);
}

char *fcNameUnparse(uint8_t *data, size_t length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, length)) return NULL;
    FcPattern *pat = decodePattern(&in);
    cmp_bytes_take(&in, NULL); // Caller frees `data`!
    if (pat == NULL) return NULL;

    char *ret = FcNameUnparse(pat);
    FcPatternDestroy(pat);
    return ret;
}

char *fcNameFormat(uint8_t *data, size_t length, char *format) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, length)) return NULL;
    FcPattern *pat = decodePattern(&in);
    cmp_bytes_take(&in, NULL); // Caller frees `data`!
    if (pat == NULL) return NULL;

    char *ret = FcPatternFormat(pat, format);
    FcPatternDestroy(pat);
    return ret;
}

uint8_t *fcFontSetList(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, uint8_t *objects, size_t objs_length, size_t *length) {
    cmp_ctx_t in;
    uint8_t *ret = NULL;

    if (!cmp_bytes_init(&in, sets, sets_length)) return NULL;
    size_t nsets;
    FcFontSet **fontsets = decodeFontSets(&in, &nsets);
    cmp_bytes_take(&in, NULL);
    if (fontsets == NULL) return NULL;

    if (!cmp_bytes_init(&in, pat, pat_length)) goto fail_pat;
    FcPattern *pattern = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (pattern == NULL) goto fail_pat;

    if (!cmp_bytes_init(&in, objects, objs_length)) goto fail_objs;
    FcObjectSet *objs = decodeObjectSet(&in);
    cmp_bytes_take(&in, NULL);
    if (objs == NULL) goto fail_objs;

    FcFontSet *res = FcFontSetList(config, fontsets, nsets, pattern, objs);

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail;
    bool ok = encodeFontSet(&out, res);
    ret = cmp_bytes_take(&out, length);
    if (!ok && ret != NULL) { free(ret); ret = NULL;}

fail:
    FcFontSetDestroy(res);
    FcObjectSetDestroy(objs);
fail_objs:
    FcPatternDestroy(pattern);
fail_pat:
    for (size_t i = 0; i < nsets; i++) FcFontSetDestroy(fontsets[i]);
    free(fontsets);
    return ret;
}


// FcResultMatch, FcResultNoMatch, FcResultTypeMismatch, FcResultNoId, FcResultOutOfMemory

uint8_t *fcFontSetMatch(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, size_t *length) {
    cmp_ctx_t in;
    uint8_t *ret = NULL;

    if (!cmp_bytes_init(&in, sets, sets_length)) return NULL;
    size_t nsets;
    FcFontSet **fontsets = decodeFontSets(&in, &nsets);
    cmp_bytes_take(&in, NULL);
    if (fontsets == NULL) return NULL;

    if (!cmp_bytes_init(&in, pat, pat_length)) goto fail;
    FcPattern *pattern = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (pattern == NULL) goto fail;

    // Necessary preprocessing!
    FcPattern *res = NULL;
    if (!FcConfigSubstitute(config, pattern, FcMatchPattern)) goto fail2;
    FcDefaultSubstitute(pattern);

    FcResult err;
    res = FcFontSetMatch(config, fontsets, nsets, pattern, &err);

    cmp_ctx_t out;
    bool ok;
    if (err == FcResultMatch) {
        if (!cmp_bytes_alloc(&out, 1024)) goto fail2;
        ok = encodePattern(&out, res);
        ret = cmp_bytes_take(&out, length);
        if (!ok && ret != NULL) { free(ret); ret = NULL; }
    } else {
        if (!cmp_bytes_alloc(&out, 32)) goto fail2;
        ok = encodeResult(&out, err);
        ret = cmp_bytes_take(&out, length);
        if (!ok && ret != NULL) { free(ret); ret = NULL; }
    }

fail2:
    if (res != NULL) FcPatternDestroy(res);
    FcPatternDestroy(pattern);
fail:
    for (size_t i = 0; i < nsets; i++) FcFontSetDestroy(fontsets[i]);
    free(fontsets);
    return ret;
}

uint8_t *fcFontSetSort(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, bool trim, size_t *length) {
    cmp_ctx_t in;
    uint8_t *ret = NULL;

    if (!cmp_bytes_init(&in, sets, sets_length)) return NULL;
    size_t nsets;
    FcFontSet **fontsets = decodeFontSets(&in, &nsets);
    cmp_bytes_take(&in, NULL);
    if (fontsets == NULL) return NULL;

    if (!cmp_bytes_init(&in, pat, pat_length)) goto fail;
    FcPattern *pattern = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (pattern == NULL) goto fail;

    // Necessary preprocessing!
    if (!FcConfigSubstitute(config, pattern, FcMatchPattern)) goto fail2;
    FcDefaultSubstitute(pattern);

    FcResult err;
    FcCharSet *charset = NULL;
    FcFontSet *res = FcFontSetSort(config, fontsets, nsets, pattern, trim, &charset, &err);

    cmp_ctx_t out;
    bool ok = true;
    switch (err) {
    case FcResultMatch:
        if (!cmp_bytes_alloc(&out, 1024*res->nfont)) goto fail3;
        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);
        }
        if (charset == NULL) cmp_write_nil(&out);
        else ok = ok || encodeCharSet(&out, charset);
        break;
    case FcResultNoMatch:
        if (!cmp_bytes_alloc(&out, 1024)) goto fail3;
        ok = ok || cmp_write_array(&out, 2);
        ok = ok || cmp_write_array(&out, 0);
        if (charset == NULL) cmp_write_nil(&out);
        else ok = ok || encodeCharSet(&out, charset);
        break;
    default:
        if (!cmp_bytes_alloc(&out, 32)) goto fail3;
        ok = ok || encodeResult(&out, err);
    }
    ret = cmp_bytes_take(&out, length);
    if (!ok && ret != NULL) { free(ret); ret = NULL; }

fail3:
    FcFontSetDestroy(res);
    if (charset != NULL) FcCharSetDestroy(charset);
fail2:
    FcPatternDestroy(pattern);
fail:
    for (size_t i = 0; i < nsets; i++) FcFontSetDestroy(fontsets[i]);
    free(fontsets);
    return ret;
}

unsigned int fcFreeTypeCharIndex(FT_Face *face, uint32_t ucs4) {
    return FcFreeTypeCharIndex(*face, ucs4);
}

uint8_t *fcFreeTypeCharSet(FT_Face *face, size_t *length) {
    FcCharSet *res = FcFreeTypeCharSet(*face, NULL);

    if (res == NULL) return NULL;
    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcCharSetDestroy(res);
        return NULL;
    }
    if (!encodeCharSet(&out, res)) {
        FcCharSetDestroy(res);
        cmp_bytes_free(&out);
        return NULL;
    }
    FcCharSetDestroy(res);
    return cmp_bytes_take(&out, length);;
}

uint8_t *fcFreeTypeCharSetAndSpacing(FT_Face *face, size_t *length) {
    int spacing;
    FcCharSet *res = FcFreeTypeCharSetAndSpacing(*face, NULL, &spacing);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcCharSetDestroy(res);
        return NULL;
    }
    if (!cmp_write_array(&out, 2)) goto fail;
    switch (spacing) { // This branches ensures a consistant ABI for Haskell to bind against.
    case FC_MONO:
        if (!cmp_write_integer(&out, 0)) goto fail;
        break;
    case FC_DUAL:
        if (!cmp_write_integer(&out, 1)) goto fail;
        break;
    case FC_PROPORTIONAL:
        if (!cmp_write_integer(&out, 2)) goto fail;
        break;
    default:
        if (!cmp_write_integer(&out, 3)) goto fail;
        break;
    }
    if (!encodeCharSet(&out, res)) goto fail;
    FcCharSetDestroy(res);
    return cmp_bytes_take(&out, length);;

fail:
    FcCharSetDestroy(res);
    cmp_bytes_free(&out);
    return NULL;
}

uint8_t *fcFreeTypeQuery(char *file, int id, size_t *length) {
    int count;
    FcPattern *res = FcFreeTypeQuery(file, id, NULL, &count);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcPatternDestroy(res);
        return NULL;
    }
    if (!cmp_write_array(&out, 2)) goto fail;
    if (!cmp_write_integer(&out, count)) goto fail;
    if (!encodePattern(&out, res)) goto fail;
    FcPatternDestroy(res);
    return cmp_bytes_take(&out, length);;

fail:
    FcPatternDestroy(res);
    cmp_bytes_free(&out);
    return NULL;
}

uint8_t *fcFreeTypeQueryAll(char *file, size_t *length) {
    int count;
    FcFontSet *fontset = FcFontSetCreate();
    if (fontset == NULL) return NULL;
    unsigned int npatterns = FcFreeTypeQueryAll(file, -1, NULL, &count, fontset);

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcFontSetDestroy(fontset);
        return NULL;
    }
    if (!cmp_write_array(&out, 3)) goto fail;
    if (!cmp_write_integer(&out, npatterns)) goto fail;
    if (!cmp_write_integer(&out, count)) goto fail;
    if (!encodeFontSet(&out, fontset)) goto fail;
    uint8_t *ret = cmp_bytes_take(&out, length);
    FcFontSetDestroy(fontset);
    return ret;

fail:
    FcFontSetDestroy(fontset);
    cmp_bytes_free(&out);
    return NULL;
}

uint8_t *fcFreeTypeQueryFace(FT_Face *face, char *file, int id, size_t *length) {
    FcPattern *res = FcFreeTypeQueryFace(*face, file, id, NULL);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcPatternDestroy(res);
        return NULL;
    }
    if (!encodePattern(&out, res)) {
        FcPatternDestroy(res);
        cmp_bytes_free(&out);
    }
    uint8_t *ret = cmp_bytes_take(&out, length);
    FcPatternDestroy(res);
    return ret;
}

int fcLangSetHasLang(uint8_t *langset, size_t length, const char *lang) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, langset, length)) return -1;
    FcLangSet *ls = decodeLangSet(&in);
    cmp_bytes_take(&in, NULL); // Caller frees `langset`
    if (ls == NULL) return -1;

    FcLangResult ret = FcLangSetHasLang(ls, lang);
    FcLangSetDestroy(ls);
    switch (ret) {
    case FcLangDifferentLang:
        return 0;
    case FcLangEqual:
        return 1;
    case FcLangDifferentTerritory:
        return 2;
    default:
        return -2;
    }
}

uint8_t *fcGetDefaultLangs(size_t *length) {
    FcStrSet *res = FcGetDefaultLangs();
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrSetDestroy(res);
        return NULL;
    }
    if (!encodeStrSet(&out, res)) {
        cmp_bytes_free(&out);
        FcStrSetDestroy(res);
        return NULL;
    }
    FcStrSetDestroy(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcGetLangs(size_t *length) {
    FcStrSet *res = FcGetLangs();
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrSetDestroy(res);
        return NULL;
    }
    if (!encodeStrSet(&out, res)) {
        cmp_bytes_free(&out);
        FcStrSetDestroy(res);
        return NULL;
    }
    FcStrSetDestroy(res);
    return cmp_bytes_take(&out, length);
}

char *fcLangNormalize(char *lang) {return FcLangNormalize(lang);}

uint8_t *fcLangGetCharSet(const char *lang, size_t *length) {
    const FcCharSet *res = FcLangGetCharSet(lang);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) return NULL;
    if (!encodeCharSet(&out, res)) {
        cmp_bytes_free(&out);
        return NULL;
    }
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigGetConfigDirs(FcConfig *conf, size_t *length) {
    FcStrList *res = FcConfigGetConfigDirs(conf);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrListDone(res);
        return NULL;
    }
    if (!encodeStrList(&out, res)) {
        cmp_bytes_free(&out);
        FcStrListDone(res);
        return NULL;
    }
    FcStrListDone(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigGetFontDirs(FcConfig *conf, size_t *length) {
    FcStrList *res = FcConfigGetFontDirs(conf);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrListDone(res);
        return NULL;
    }
    if (!encodeStrList(&out, res)) {
        cmp_bytes_free(&out);
        FcStrListDone(res);
        return NULL;
    }
    FcStrListDone(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigGetConfigFiles(FcConfig *conf, size_t *length) {
    FcStrList *res = FcConfigGetConfigFiles(conf);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrListDone(res);
        return NULL;
    }
    if (!encodeStrList(&out, res)) {
        cmp_bytes_free(&out);
        FcStrListDone(res);
        return NULL;
    }
    FcStrListDone(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigGetCacheDirs(FcConfig *conf, size_t *length) {
    FcStrList *res = FcConfigGetCacheDirs(conf);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcStrListDone(res);
        return NULL;
    }
    if (!encodeStrList(&out, res)) {
        cmp_bytes_free(&out);
        FcStrListDone(res);
        return NULL;
    }
    FcStrListDone(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigGetFonts(FcConfig *conf, bool system, size_t *length) {
    FcFontSet *res = FcConfigGetFonts(conf, system ? FcSetSystem : FcSetApplication);
    if (res == NULL) return NULL;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) {
        FcFontSetDestroy(res);
        return NULL;
    }
    if (!encodeFontSet(&out, res)) {
        cmp_bytes_free(&out);
        FcFontSetDestroy(res);
        return NULL;
    }
    FcFontSetDestroy(res);
    return cmp_bytes_take(&out, length);
}

uint8_t *fcConfigSubstituteWithPat(FcConfig *conf, uint8_t *data, size_t in_length, bool isFont, size_t *length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, in_length)) return NULL;

    uint32_t size = 0;
    if (!cmp_read_array(&in, &size) || size < 1 || size > 2) return NULL;
    FcPattern *p = decodePattern(&in);
    if (p == NULL) {cmp_bytes_take(&in, NULL); return NULL;}
    FcPattern *p_pat = NULL;
    if (size == 2) {
        p_pat = decodePattern(&in);
        if (p_pat == NULL) {cmp_bytes_take(&in, NULL); goto fail;}
    }
    cmp_bytes_take(&in, NULL);

    if (!FcConfigSubstituteWithPat(conf, p, p_pat, isFont ? FcMatchFont : FcMatchPattern)) goto fail;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail;
    if (!encodePattern(&out, p)) goto fail;
    FcPatternDestroy(p);
    if (p_pat != NULL) FcPatternDestroy(p_pat);
    return cmp_bytes_take(&out, length);

fail:
    FcPatternDestroy(p);
    if (p_pat != NULL) FcPatternDestroy(p_pat);
    return NULL;
}

uint8_t *fcFontMatch(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, in_length)) return NULL;
    FcPattern *p = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (p == NULL) return NULL;

    if (!FcConfigSubstitute(conf, p, FcMatchPattern)) goto fail;
    FcDefaultSubstitute(p);

    FcResult err;
    FcPattern *res = FcFontMatch(conf, p, &err);
    if (res == NULL) goto fail;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail;
    if (err != FcResultMatch) {
        if (!encodeResult(&out, err)) goto fail2;
    } else {
        if (!encodePattern(&out, res)) goto fail2;
    }
    FcPatternDestroy(p);
    return cmp_bytes_take(&out, length);;

fail2:
    cmp_bytes_free(&out);
fail:
    FcPatternDestroy(p);
    return NULL;
}

uint8_t *fcFontSort(FcConfig *conf, uint8_t *data, size_t in_length, bool trim, size_t *length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, in_length)) return NULL;
    FcPattern *p = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (p == NULL) return NULL;

    if (!FcConfigSubstitute(conf, p, FcMatchPattern)) goto fail;
    FcDefaultSubstitute(p);

    FcResult err;
    FcCharSet *csp;
    FcFontSet *res = FcFontSort(conf, p, trim, &csp, &err);
    if (res == NULL) goto fail2;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail2;
    if (err != FcResultMatch) {
        if (!encodeResult(&out, err)) goto fail3;
    } else if (csp != NULL) {
        if (!cmp_write_array(&out, 2)) goto fail3;
        if (!encodeFontSet(&out, res)) goto fail3;
        if (!encodeCharSet(&out, csp)) goto fail3;
    } else {
        if (!cmp_write_array(&out, 1)) goto fail3;
        if (!encodeFontSet(&out, res)) goto fail3;
    }
    FcPatternDestroy(p);
    if (csp != NULL) FcCharSetDestroy(csp);
    return cmp_bytes_take(&out, length);

fail3:
    cmp_bytes_free(&out);
fail2:
    if (csp != NULL) FcCharSetDestroy(csp);
fail:
    FcPatternDestroy(p);
    return NULL;
}

uint8_t *fcFontRenderPrepare(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, in_length)) return NULL;
    uint32_t size = 0;
    if (!cmp_read_array(&in, &size) || size != 2) return NULL;
    FcPattern *pat = decodePattern(&in);
    if (pat == NULL) {cmp_bytes_take(&in, NULL); return NULL;}
    FcPattern *font = decodePattern(&in);
    cmp_bytes_take(&in, NULL);
    if (font == NULL) {FcPatternDestroy(pat); return NULL; }

    FcPattern *res = FcFontRenderPrepare(conf, pat, font);
    if (res == NULL) goto fail0;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail;
    if (!encodePattern(&out, res)) {cmp_bytes_free(&out); goto fail;}
    FcPatternDestroy(pat);
    FcPatternDestroy(font);
    FcPatternDestroy(res);
    return cmp_bytes_take(&out, length);

fail:
    FcPatternDestroy(res);
fail0:
    FcPatternDestroy(pat);
    FcPatternDestroy(font);
    return NULL;
}

uint8_t *fcFontList(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, in_length)) return NULL;
    uint32_t size = 0;
    if (!cmp_read_array(&in, &size) || size != 2) {
        cmp_bytes_take(&in, NULL);
        return NULL;
    }
    FcPattern *pat = decodePattern(&in);
    if (pat == NULL) {cmp_bytes_take(&in, NULL); return NULL;}
    FcObjectSet *os = decodeObjectSet(&in);
    cmp_bytes_take(&in, NULL);
    if (os == NULL) {FcPatternDestroy(pat); return NULL;}

    FcFontSet *res = FcFontList(conf, pat, os);
    if (res == NULL) goto fail0;

    cmp_ctx_t out;
    if (!cmp_bytes_alloc(&out, 1024)) goto fail;
    if (!encodeFontSet(&out, res)) { cmp_bytes_free(&out); goto fail;}
    FcFontSetDestroy(res);
    return cmp_bytes_take(&out, length);

fail:
    FcFontSetDestroy(res);
fail0:
    FcPatternDestroy(pat);
    FcObjectSetDestroy(os);
    return NULL;
}

/*int fcConfigAcceptFont(FcConfig *conf, uint8_t *data, size_t length) {
    cmp_ctx_t in;
    if (!cmp_bytes_init(&in, data, length)) return -1;
    FcPattern *pat = decodePattern(&in);
    if (pat == NULL) return -1;

    FcBool ret = FcConfigAcceptFont(conf, pat);
    FcPatternDestroy(pat);
    return ret ? 1 : 0;
}*/

M cbits/fontconfig-wrap.h => cbits/fontconfig-wrap.h +2 -0
@@ 20,10 20,12 @@ uint8_t *fcFreeTypeCharSetAndSpacing(FT_Face *face, size_t *length);
uint8_t *fcFreeTypeQuery(char *file, int id, size_t *length);
uint8_t *fcFreeTypeQueryAll(char *file, size_t *length);
uint8_t *fcFreeTypeQueryFace(FT_Face *face, char *file, int id, size_t *length);
int fcLangSetCompare(uint8_t *langset, size_t length);
int fcLangSetHasLang(uint8_t *langset, size_t length, const char *lang);
uint8_t *fcGetDefaultLangs(size_t *length);
uint8_t *fcGetLangs(size_t *length);
char *fcLangNormalize(char *lang);
uint8_t *fcLangGetCharSet(const char *lang, size_t *length);
uint8_t *fcConfigGetConfigDirs(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetFontDirs(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetConfigFiles(FcConfig *conf, size_t *length);

D cbits/fontconfig-wrap.h~ => cbits/fontconfig-wrap.h~ +0 -37
@@ 1,37 0,0 @@
#include <fontconfig/fontconfig.h>
#include <fontconfig/fcfreetype.h>
#include <stdint.h>
#include <stdbool.h>

int fcPatternEqualSubset(uint8_t *data, size_t length);
uint8_t *fcDefaultSubstitute(uint8_t *data, size_t in_length, size_t *)
uint8_t *fcNameParse(char *name, size_t *length);
char *fcNameUnparse(uint8_t *data, size_t length);
char *fcNameFormat(uint8_t *data, size_t length, char *format);
uint8_t *fcFontSetList(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, uint8_t *objects, size_t objs_length, size_t *length);
uint8_t *fcFontSetMatch(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, size_t *length);
uint8_t *fcFontSetSort(FcConfig *config, uint8_t *sets, size_t sets_length,
        uint8_t *pat, size_t pat_length, bool trim, size_t *length);
unsigned int fcFreeTypeCharIndex(FT_Face *face, uint32_t ucs4);
uint8_t *fcFreeTypeCharSet(FT_Face *face, size_t *length);
uint8_t *fcFreeTypeCharSetAndSpacing(FT_Face *face, size_t *length);
uint8_t *fcFreeTypeQuery(char *file, int id, size_t *length);
uint8_t *fcFreeTypeQueryAll(char *file, size_t *length);
uint8_t *fcFreeTypeQueryFace(FT_Face *face, char *file, int id, size_t *length);
int fcLangSetHasLang(uint8_t *langset, size_t length, const char *lang);
uint8_t *fcGetDefaultLangs(size_t *length);
uint8_t *fcGetLangs(size_t *length);
char *fcLangNormalize(char *lang);
uint8_t *fcConfigGetConfigDirs(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetFontDirs(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetConfigFiles(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetCacheDirs(FcConfig *conf, size_t *length);
uint8_t *fcConfigGetFonts(FcConfig *conf, bool system, size_t *length);
uint8_t *fcConfigSubstituteWithPat(FcConfig *conf, uint8_t *data, size_t in_length, bool isFont, size_t *length);
uint8_t *fcFontMatch(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length);
uint8_t *fcFontSort(FcConfig *conf, uint8_t *data, size_t in_length, bool trim, size_t *length);
uint8_t *fcFontRenderPrepare(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length);
uint8_t *fcFontList(FcConfig *conf, uint8_t *data, size_t in_length, size_t *length);


M fontconfig-pure.cabal => fontconfig-pure.cabal +2 -1
@@ 68,7 68,8 @@ library
            Graphics.Text.Font.Choose.StrSet, Graphics.Text.Font.Choose.Value,
            Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet,
            Graphics.Text.Font.Choose.Config, Graphics.Text.Font.Choose.Result,
            Graphics.Text.Font.Choose.Internal.FFI
            Graphics.Text.Font.Choose.Internal.FFI, FreeType.FontConfig,
            Graphics.Text.Font.Choose.Config.Accessors

    c-sources: cbits/cmp.c, cbits/transcode.c, cbits/fontconfig-wrap.c
    include-dirs: cbits

A lib/FreeType/FontConfig.hs => lib/FreeType/FontConfig.hs +43 -0
@@ 0,0 1,43 @@
{-# LANGUAGE CApiFFI #-}
module FreeType.FontConfig where

import FreeType.Core.Base (FT_Face)

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString)

import Graphics.Text.Font.Choose.CharSet (CharSet')
import Graphics.Text.Font.Choose.Pattern (Pattern)
import Graphics.Text.Font.Choose.FontSet (FontSet)
import Graphics.Text.Font.Choose.Internal.FFI (fromMessage0, withCString')

foreign import capi "fontconfig-wrap.h fcFreeTypeCharIndex" charIndex :: FT_Face -> Char -> Word

fontCharSet :: FT_Face -> CharSet'
fontCharSet arg = fromMessage0 $ fcFreeTypeCharSet arg

foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSet :: FT_Face -> Ptr Int -> CString

fontCharSetAndSpacing :: FT_Face -> (Int, CharSet')
fontCharSetAndSpacing arg = fromMessage0 $ fcFreeTypeCharSetAndSpacing arg

foreign import capi "fontconfig-wrap.h" fcFreeTypeCharSetAndSpacing ::
    FT_Face -> Ptr Int -> CString

fontQuery :: FilePath -> Int -> (Int, Pattern)
fontQuery a b = fromMessage0 $ flip withCString' a $ \a' -> fcFreeTypeQuery a' b

foreign import capi "fontconfig-wrap.h" fcFreeTypeQuery ::
    CString -> Int -> Ptr Int -> CString

fontQueryAll :: FilePath -> (Int, Int, FontSet)
fontQueryAll a = fromMessage0 $ withCString' fcFreeTypeQueryAll a

foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryAll ::
    CString -> Ptr Int -> CString

fontQueryFace :: FT_Face -> FilePath -> Int -> Pattern
fontQueryFace a b c = fromMessage0 $ flip withCString' b $ \b' -> fcFreeTypeQueryFace a b' c

foreign import capi "fontconfig-wrap.h" fcFreeTypeQueryFace ::
    FT_Face -> CString -> Int -> Ptr Int -> CString

A lib/Graphics/Text/Font/Choose/Config/Accessors.hs => lib/Graphics/Text/Font/Choose/Config/Accessors.hs +161 -0
@@ 0,0 1,161 @@
{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.Config.Accessors where

import Graphics.Text.Font.Choose.Config
import Graphics.Text.Font.Choose.FontSet
import Graphics.Text.Font.Choose.Pattern
import Graphics.Text.Font.Choose.CharSet
import Graphics.Text.Font.Choose.ObjectSet

import Foreign.Ptr (Ptr)
import Foreign.ForeignPtr (newForeignPtr, withForeignPtr)
import Foreign.C.String (CString, withCString, peekCString)
--import Foreign.C.ConstPtr (ConstPtr)
--import Foreign.C.Types (CChar)

import Graphics.Text.Font.Choose.Result (throwBool, throwNull)
import Graphics.Text.Font.Choose.Internal.FFI (peekCString', fromMessageIO0,
                withMessage, withForeignPtr', fromMessage0, fromMessage)

configCreate :: IO Config
configCreate = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigCreate
foreign import capi "fontconfig/fontconfig.h FcConfigCreate" fcConfigCreate :: IO (Ptr Config')

setCurrent :: Config -> IO ()
setCurrent conf = throwBool =<< withForeignPtr conf fcConfigSetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigSetCurrent" fcConfigSetCurrent :: Ptr Config' -> IO Bool

current :: IO Config
current = newForeignPtr fcConfigDestroy =<< throwNull =<< fcConfigGetCurrent
foreign import capi "fontconfig/fontconfig.h FcConfigGetCurrent" fcConfigGetCurrent :: IO (Ptr Config')

uptodate :: Config -> IO Bool
uptodate conf = withForeignPtr conf fcConfigUptoDate
foreign import capi "fontconfig/fontconfig.h FcConfigUptoDate" fcConfigUptoDate :: Ptr Config' -> IO Bool

home :: String
home = peekCString' fcConfigHome
foreign import capi "fontconfig/fontconfig.h FcConfigHome" fcConfigHome :: CString

foreign import capi "fontconfig/fontconfig.h FcConfigEnableHome" enableHome :: Bool -> IO Bool

buildFonts :: Config -> IO ()
buildFonts conf = throwBool =<< withForeignPtr conf fcConfigBuildFonts
foreign import capi "fontconfig/fontconfig.h FcConfigBuildFonts" fcConfigBuildFonts :: Ptr Config' -> IO Bool

configDirs :: Config -> IO [String]
configDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigDirs :: Ptr Config' -> Ptr Int -> IO CString

fontDirs :: Config -> IO [String]
fontDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFontDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetFontDirs :: Ptr Config' -> Ptr Int -> IO CString

configFiles :: Config -> IO [String]
configFiles conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetConfigFiles conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetConfigFiles :: Ptr Config' -> Ptr Int -> IO CString

cacheDirs :: Config -> IO [String]
cacheDirs conf =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetCacheDirs conf' len
foreign import capi "fontconfig-wrap.h" fcConfigGetCacheDirs :: Ptr Config' -> Ptr Int -> IO CString

data SetName = System | App deriving Eq
fonts :: Config -> SetName -> IO FontSet
fonts conf setname =
    fromMessageIO0 $ \len -> withForeignPtr conf $ \conf' -> fcConfigGetFonts conf' (setname == System) len
foreign import capi "fontconfig-wrap.h" fcConfigGetFonts :: Ptr Config' -> Bool -> Ptr Int -> IO CString

rescanInterval :: Config -> IO Int
rescanInterval = flip withForeignPtr fcConfigGetRescanInterval
foreign import capi "fontconfig/fontconfig.h FcConfigGetRescanInterval" fcConfigGetRescanInterval ::
        Ptr Config' -> IO Int

setRescanInterval :: Config -> Int -> IO ()
setRescanInterval conf period =
    throwBool =<< withForeignPtr conf (flip fcConfigSetRescanInterval period)
foreign import capi "fontconfig/fontconfig.h FcConfigSetRescanInterval" fcConfigSetRescanInterval ::
        Ptr Config' -> Int -> IO Bool

appFontAddFile :: Config -> FilePath -> IO ()
appFontAddFile conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddFile conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddFile" fcConfigAppFontAddFile ::
        Ptr Config' -> CString -> IO Bool

appFontAddDir :: Config -> FilePath -> IO ()
appFontAddDir conf file = throwBool =<< withForeignPtr conf (\conf' ->
        withCString file $ \file' -> fcConfigAppFontAddDir conf' file')
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontAddDir" fcConfigAppFontAddDir ::
        Ptr Config' -> CString -> IO Bool

appFontClear :: Config -> IO ()
appFontClear = flip withForeignPtr fcConfigAppFontClear
foreign import capi "fontconfig/fontconfig.h FcConfigAppFontClear" fcConfigAppFontClear ::
        Ptr Config' -> IO ()

data MatchKind = MatchPattern | MatchFont deriving Eq
substituteWithPat :: Config -> Pattern -> Maybe Pattern -> MatchKind -> Pattern
substituteWithPat conf p (Just p_pat) kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p, p_pat] $ \msg len -> 
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
substituteWithPat conf p Nothing kind =
    fromMessage0 $ flip withForeignPtr' conf $ \conf' -> flip withMessage [p] $ \msg len ->
        fcConfigSubstituteWithPat conf' msg len (kind == MatchFont)
foreign import capi "fontconfig-wrap.h" fcConfigSubstituteWithPat ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

fontMatch :: Config -> Pattern -> Maybe Pattern
fontMatch conf pat = fromMessage $ flip withMessage pat $ withForeignPtr' fcFontMatch conf
foreign import capi "fontconfig-wrap.h" fcFontMatch :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

fontSort :: Config -> Pattern -> Bool -> Maybe (FontSet, CharSet')
fontSort conf pat trim = fromMessage $ (flip withMessage pat $ withForeignPtr' fcFontSort conf) trim
foreign import capi "fontconfig-wrap.h" fcFontSort ::
    Ptr Config' -> CString -> Int -> Bool -> Ptr Int -> CString

fontRenderPrepare :: Config -> Pattern -> Pattern -> Pattern
fontRenderPrepare conf pat font = fromMessage0 $ flip withMessage [pat, font] $
        withForeignPtr' fcFontRenderPrepare conf
foreign import capi "fontconfig-wrap.h" fcFontRenderPrepare ::
    Ptr Config' -> CString -> Int -> Ptr Int -> CString

fontList :: Config -> Pattern -> ObjectSet -> FontSet
fontList conf pat os = fromMessage0 $ flip withMessage (pat, os) $ withForeignPtr' fcFontList conf
foreign import capi "fontconfig-wrap.h" fcFontList :: Ptr Config' -> CString -> Int -> Ptr Int -> CString

filename :: Config -> FilePath -> IO FilePath
filename conf path =
    peekCString =<< withForeignPtr conf (\_ -> withCString path $ fcConfigGetFilename)
foreign import capi "fontconfig/fontconfig.h FcConfigFilename" fcConfigGetFilename ::
    CString -> IO CString -- FIXME: Recent docs say it's "Get" now...

parseAndLoad :: Config -> FilePath -> Bool -> IO ()
parseAndLoad conf path complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString path $ \path' ->
        fcConfigParseAndLoad conf' path' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoad" fcConfigParseAndLoad ::
    Ptr Config' -> CString -> Bool -> IO Bool
parseAndLoadFromMemory :: Config -> FilePath -> Bool -> IO ()
parseAndLoadFromMemory conf buf complain =
    throwBool =<< withForeignPtr conf (\conf' -> withCString buf $ \buf' ->
        fcConfigParseAndLoadFromMemory conf' buf' complain)
foreign import capi "fontconfig/fontconfig.h FcConfigParseAndLoadFromMemory"
    fcConfigParseAndLoadFromMemory :: Ptr Config' -> CString -> Bool -> IO Bool

sysroot :: Config -> IO String
sysroot conf = peekCString =<< withForeignPtr conf fcConfigGetSysRoot
-- FIXME: Upgrade GHC so I can use const pointers!
foreign import ccall "fontconfig/fontconfig.h FcConfigGetSysRoot" fcConfigGetSysRoot ::
    Ptr Config' -> IO CString

setSysroot :: Config -> String -> IO ()
setSysroot conf root =
    withForeignPtr conf $ \conf' -> withCString root $ fcConfigSetSysRoot conf'
foreign import capi "fontconfig/fontconfig.h FcConfigSetSysRoot" fcConfigSetSysRoot ::
    Ptr Config' -> CString -> IO ()

-- TODO (maybe): FcConfigFileInfoIterInit, FcConfigFileInfoIterNext, & FcConfigFileInfoIterGet

M lib/Graphics/Text/Font/Choose/FontSet.hs => lib/Graphics/Text/Font/Choose/FontSet.hs +37 -1
@@ 1,8 1,44 @@
{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.FontSet where

import Graphics.Text.Font.Choose.Pattern
import Graphics.Text.Font.Choose.Config
import Graphics.Text.Font.Choose.ObjectSet
import Graphics.Text.Font.Choose.CharSet
import Graphics.Text.Font.Choose.Internal.FFI

type FontSet = [Pattern']
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)
import Data.MessagePack (MessagePack)

type FontSet = [Pattern]

fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet -> FontSet
fontSetList a b c d =
    fromMessage0 $ arg d $ arg c $ arg b $ withForeignPtr' fcFontSetList a

foreign import capi "fontconfig-wrap.h" fcFontSetList ::
        Ptr Config' -> CString -> Int -> CString -> Int -> CString -> Int ->
        Ptr Int -> CString

fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe FontSet
fontSetMatch a b c = fromMessage $ arg c $ arg b $ withForeignPtr' fcFontSetMatch a

foreign import capi "fontconfig-wrap.h" fcFontSetMatch ::
        Ptr Config' -> CString -> Int -> CString -> Int -> Ptr Int -> CString

fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> (Maybe FontSet, CharSet')
fontSetSort a b c d = fromMessage0 $ flip withForeignPtr' a $ \a' ->
        arg b $ \b' x -> arg c $ \c' y -> fcFontSetSort a' b' x c' y d

foreign import capi "fontconfig-wrap.h" fcFontSetSort ::
        Ptr Config' -> CString -> Int -> CString -> Int -> Bool -> Ptr Int -> CString

------
--- Utilities
------
arg :: MessagePack a => a -> (CString -> Int -> b) -> b
arg = flip withMessage

------
--- CSS Bindings

M lib/Graphics/Text/Font/Choose/Internal/FFI.hs => lib/Graphics/Text/Font/Choose/Internal/FFI.hs +22 -3
@@ 1,8 1,9 @@
module Graphics.Text.Font.Choose.Internal.FFI where

import Data.MessagePack (MessagePack, pack, unpack)
import Foreign.C.String (CString, withCString)
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 Data.Tuple (swap)


@@ 13,9 14,11 @@ import Data.ByteString.Unsafe (unsafeUseAsCStringLen, unsafePackMallocCStringLen
import Data.ByteString.Lazy (toStrict, fromStrict)
import System.IO.Unsafe (unsafePerformIO)

withMessageIO :: MessagePack a => (CString -> Int -> IO b) -> a -> IO b
withMessageIO cb a = unsafeUseAsCStringLen (toStrict $ pack a) (uncurry cb)

withMessage :: MessagePack a => (CString -> Int -> b) -> a -> b
withMessage inner arg = unsafePerformIO $
    unsafeUseAsCStringLen (toStrict $ pack arg) (return . uncurry inner)
withMessage inner arg = unsafePerformIO $ withMessageIO (\x -> return . inner x) arg

fromMessage :: MessagePack a => (Ptr Int -> CString) -> Maybe a
fromMessage inner = unpack $ fromStrict $ unsafePerformIO $ do


@@ 24,9 27,25 @@ fromMessage inner = unpack $ fromStrict $ unsafePerformIO $ do
fromMessage0 :: MessagePack a => (Ptr Int -> CString) -> a
fromMessage0 = fromJust . fromMessage

fromMessageIO :: MessagePack a => (Ptr Int -> IO CString) -> IO (Maybe a)
fromMessageIO inner = do
    (a, b) <- withPtr $ \ptr -> do
        throwNull =<< inner ptr
    bs <- unsafePackMallocCStringLen (b, a)
    return $ unpack $ fromStrict bs

fromMessageIO0 :: MessagePack a => (Ptr Int -> IO CString) -> IO a
fromMessageIO0 inner = fromJust <$> fromMessageIO inner

withCString' :: (CString -> a) -> String -> a
withCString' inner = unsafePerformIO . flip withCString (return . inner)

peekCString' :: CString -> String
peekCString' = unsafePerformIO . peekCString

withForeignPtr' :: (Ptr a -> b) -> ForeignPtr a -> b
withForeignPtr' inner arg = unsafePerformIO $ withForeignPtr arg $ return . inner

-- I don't want to pull in all of inline-c for this util!
withPtr :: (Storable a) => (Ptr a -> IO b) -> IO (a, b)
withPtr f = do

M lib/Graphics/Text/Font/Choose/LangSet.hs => lib/Graphics/Text/Font/Choose/LangSet.hs +45 -1
@@ 1,9 1,18 @@
{-# LANGUAGE CApiFFI #-}
module Graphics.Text.Font.Choose.LangSet where

import Data.Set (Set)
import qualified Data.Set as S

import Data.MessagePack (MessagePack(..))
import Graphics.Text.Font.Choose.StrSet (StrSet)
import Graphics.Text.Font.Choose.CharSet (CharSet')

import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)
import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCString', peekCString')
import Graphics.Text.Font.Choose.Result
import Control.Exception (throw)

type LangSet = Set String
newtype LangSet' = LangSet' { unLangSet :: LangSet }


@@ 12,4 21,39 @@ instance MessagePack LangSet' where
    toObject = toObject . S.toList . unLangSet
    fromObject msg = LangSet' <$> S.fromList <$> fromObject msg

-- TODO: Implement language bindings! But first: Datamodel everything!
data LangComparison = SameLang | SameTerritory | DifferentLang
i2cmp :: Int -> LangComparison
i2cmp 0 = DifferentLang
i2cmp 1 = SameLang
i2cmp 2 = SameTerritory
i2cmp _ = throw ErrOOM

cmp :: LangSet' -> LangSet' -> LangComparison
cmp a b = i2cmp $ withMessage fcLangSetCompare [a, b]

foreign import capi "fontconfig-wrap.h" fcLangSetCompare :: CString -> Int -> Int

has :: LangSet' -> String -> LangComparison
has a b = i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a

foreign import capi "fontconfig-wrap.h" fcLangSetHasLang :: CString -> Int -> CString -> Int

defaultLangs :: StrSet
defaultLangs = fromMessage0 fcGetDefaultLangs

foreign import capi "fontconfig-wrap.h" fcGetDefaultLangs :: Ptr Int -> CString

langs :: StrSet
langs = fromMessage0 fcGetLangs

foreign import capi "fontconfig-wrap.h" fcGetLangs :: Ptr Int -> CString

normalize :: String -> String
normalize = peekCString' . withCString' fcLangNormalize

foreign import capi "fontconfig-wrap.h" fcLangNormalize :: CString -> CString

langCharSet :: String -> CharSet'
langCharSet = fromMessage0 . withCString' fcLangGetCharSet

foreign import capi "fontconfig-wrap.h" fcLangGetCharSet :: CString -> Ptr Int -> CString

M lib/Graphics/Text/Font/Choose/Pattern.hs => lib/Graphics/Text/Font/Choose/Pattern.hs +8 -4
@@ 6,11 6,10 @@ import Data.MessagePack (MessagePack(..), Object(..))
import Data.Hashable (Hashable(..))
import GHC.Generics (Generic)

import Foreign.C.String (CString, peekCString)
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr)
import Control.Exception (throw)
import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCString')
import System.IO.Unsafe (unsafePerformIO)
import Graphics.Text.Font.Choose.Internal.FFI (withMessage, fromMessage0, withCString', peekCString')

import Graphics.Text.Font.Choose.Value
import Graphics.Text.Font.Choose.ObjectSet


@@ 50,10 49,15 @@ nameParse = fromMessage0 . withCString' fcNameParse
foreign import capi "fontconfig-wrap.h" fcNameParse :: CString -> Ptr Int -> CString

nameUnparse :: Pattern -> String
nameUnparse = unsafePerformIO . peekCString . withMessage fcNameUnparse
nameUnparse = peekCString' . withMessage fcNameUnparse

foreign import capi "fontconfig-wrap.h" fcNameUnparse :: CString -> Int -> CString

nameFormat :: Pattern -> String -> String
nameFormat a b = peekCString' $ flip withCString' b $ withMessage fcNameFormat a

foreign import capi "fontconfig-wrap.h" fcNameFormat :: CString -> Int -> CString -> CString

------
--- CSS
------