From 9aee49dd6084ce6deef6099a3b7c27fa0f6c8b1e Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 11 Apr 2024 13:07:46 +1200 Subject: [PATCH] Finish initial redraft --- cbits/fontconfig-wrap.c | 34 +- cbits/fontconfig-wrap.c~ | 681 ------------------ cbits/fontconfig-wrap.h | 2 + cbits/fontconfig-wrap.h~ | 37 - fontconfig-pure.cabal | 3 +- lib/FreeType/FontConfig.hs | 43 ++ .../Text/Font/Choose/Config/Accessors.hs | 161 +++++ lib/Graphics/Text/Font/Choose/FontSet.hs | 38 +- lib/Graphics/Text/Font/Choose/Internal/FFI.hs | 25 +- lib/Graphics/Text/Font/Choose/LangSet.hs | 46 +- lib/Graphics/Text/Font/Choose/Pattern.hs | 12 +- 11 files changed, 347 insertions(+), 735 deletions(-) delete mode 100644 cbits/fontconfig-wrap.c~ delete mode 100644 cbits/fontconfig-wrap.h~ create mode 100644 lib/FreeType/FontConfig.hs create mode 100644 lib/Graphics/Text/Font/Choose/Config/Accessors.hs diff --git a/cbits/fontconfig-wrap.c b/cbits/fontconfig-wrap.c index b000b0a..cd4e3db 100644 --- a/cbits/fontconfig-wrap.c +++ b/cbits/fontconfig-wrap.c @@ -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); diff --git a/cbits/fontconfig-wrap.c~ b/cbits/fontconfig-wrap.c~ deleted file mode 100644 index 5679109..0000000 --- a/cbits/fontconfig-wrap.c~ +++ /dev/null @@ -1,681 +0,0 @@ -#include "transcode.h" -#include -#include -#include - -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; -}*/ diff --git a/cbits/fontconfig-wrap.h b/cbits/fontconfig-wrap.h index e4c6970..303db4d 100644 --- a/cbits/fontconfig-wrap.h +++ b/cbits/fontconfig-wrap.h @@ -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); diff --git a/cbits/fontconfig-wrap.h~ b/cbits/fontconfig-wrap.h~ deleted file mode 100644 index 5ae535e..0000000 --- a/cbits/fontconfig-wrap.h~ +++ /dev/null @@ -1,37 +0,0 @@ -#include -#include -#include -#include - -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); - diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal index 22f60f1..1d5223c 100644 --- a/fontconfig-pure.cabal +++ b/fontconfig-pure.cabal @@ -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 diff --git a/lib/FreeType/FontConfig.hs b/lib/FreeType/FontConfig.hs new file mode 100644 index 0000000..c3a06b7 --- /dev/null +++ b/lib/FreeType/FontConfig.hs @@ -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 diff --git a/lib/Graphics/Text/Font/Choose/Config/Accessors.hs b/lib/Graphics/Text/Font/Choose/Config/Accessors.hs new file mode 100644 index 0000000..653610c --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/Config/Accessors.hs @@ -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 diff --git a/lib/Graphics/Text/Font/Choose/FontSet.hs b/lib/Graphics/Text/Font/Choose/FontSet.hs index 151fbc7..d0d86fc 100644 --- a/lib/Graphics/Text/Font/Choose/FontSet.hs +++ b/lib/Graphics/Text/Font/Choose/FontSet.hs @@ -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 diff --git a/lib/Graphics/Text/Font/Choose/Internal/FFI.hs b/lib/Graphics/Text/Font/Choose/Internal/FFI.hs index e63ca35..36b5faf 100644 --- a/lib/Graphics/Text/Font/Choose/Internal/FFI.hs +++ b/lib/Graphics/Text/Font/Choose/Internal/FFI.hs @@ -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 diff --git a/lib/Graphics/Text/Font/Choose/LangSet.hs b/lib/Graphics/Text/Font/Choose/LangSet.hs index 905fce9..1fb0c3c 100644 --- a/lib/Graphics/Text/Font/Choose/LangSet.hs +++ b/lib/Graphics/Text/Font/Choose/LangSet.hs @@ -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 diff --git a/lib/Graphics/Text/Font/Choose/Pattern.hs b/lib/Graphics/Text/Font/Choose/Pattern.hs index fda2265..31c4c24 100644 --- a/lib/Graphics/Text/Font/Choose/Pattern.hs +++ b/lib/Graphics/Text/Font/Choose/Pattern.hs @@ -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 ------ -- 2.30.2