diff --git a/c/libs/xft.c b/c/libs/xft.c index 0d8b8e3..837b4cc 100644 --- a/c/libs/xft.c +++ b/c/libs/xft.c @@ -477,9 +477,9 @@ void scx_xft_init(void) XFT_GC_PROTECT_IMPORT_BINDING(scx_xftobjectset_record_type, "xft-objectset"); XFT_GC_PROTECT_IMPORT_BINDING(scx_xftfontset_record_type, "xft-fontset"); - SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-match", scx_XftResultMatch, + SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-match", scx_XftResultMatch, XftResultMatch); - SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-no-match", scx_XftResultNoMatch, + SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-no-match", scx_XftResultNoMatch, XftResultNoMatch); SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-type-mismatch", scx_XftResultTypeMismatch, XftResultTypeMismatch); @@ -490,6 +490,55 @@ void scx_xft_init(void) SCX_EXPORT_INTEGER_TO_S48("scx-xft-version-minor", scx_XftVersionMinor, SCX_XFT_VERSION_MINOR); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-family", scx_xft_pattern_family, + SCX_XFT_FAMILY); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-style", scx_xft_pattern_style, + SCX_XFT_STYLE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-slant", scx_xft_pattern_slant, + SCX_XFT_SLANT); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-weight", scx_xft_pattern_weight, + SCX_XFT_WEIGHT); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-size", scx_xft_pattern_size, + SCX_XFT_SIZE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-pixel-size", scx_xft_pattern_pixel_size, + SCX_XFT_PIXEL_SIZE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-encoding", scx_xft_pattern_encoding, + SCX_XFT_ENCODING); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-spacing", scx_xft_pattern_spacing, + SCX_XFT_SPACING); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-foundry", scx_xft_pattern_foundry, + SCX_XFT_FOUNDRY); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-core", scx_xft_pattern_core, + SCX_XFT_CORE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-antialias", scx_xft_pattern_antialias, + SCX_XFT_ANTIALIAS); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-xlfd", scx_xft_pattern_xlfd, + SCX_XFT_XLFD); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-file", scx_xft_pattern_file, + SCX_XFT_FILE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-index", scx_xft_pattern_index, + SCX_XFT_INDEX); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-rasterizer", scx_xft_pattern_rasterizer, + SCX_XFT_RASTERIZER); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-outline", scx_xft_pattern_outline, + SCX_XFT_OUTLINE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-scalable", scx_xft_pattern_scalable, + SCX_XFT_SCALABLE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-rgba", scx_xft_pattern_rgba, + SCX_XFT_RGBA); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-scale", scx_xft_pattern_scale, + SCX_XFT_SCALE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-render", scx_xft_pattern_render, + SCX_XFT_RENDER); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-minspace", scx_xft_pattern_minspace, + SCX_XFT_MINSPACE); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-dpi", scx_xft_pattern_dpi, + SCX_XFT_DPI); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-char-width", scx_xft_pattern_char_width, + SCX_XFT_CHAR_WIDTH); + SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-char-height", scx_xft_pattern_char_height, + SCX_XFT_CHAR_HEIGHT); + S48_EXPORT_FUNCTION(scx_XftPatternCreate); S48_EXPORT_FUNCTION(scx_XftPatternDestroy); S48_EXPORT_FUNCTION(scx_XftPatternDuplicate); diff --git a/c/libs/xft.h b/c/libs/xft.h index 6e1f759..375051e 100644 --- a/c/libs/xft.h +++ b/c/libs/xft.h @@ -94,25 +94,53 @@ static struct xft_pattern_property xft_pattern_property_tbl [] = { {NULL, NULL, SCX_XFT_INVALID} }; -/* scheme record types */ -static s48_value scx_xftpattern_record_type = S48_FALSE; -static s48_value scx_xftfont_record_type = S48_FALSE; -static s48_value scx_xftdraw_record_type = S48_FALSE; -static s48_value scx_xftcolor_record_type = S48_FALSE; -static s48_value scx_xftobjectset_record_type = S48_FALSE; -static s48_value scx_xftfontset_record_type = S48_FALSE; +/* declare static s48_value initialized with S48_FALSE */ +#define SCX_DECLARE_STATIC_S48VAL(NAME) static s48_value NAME = S48_FALSE #define XFT_GC_PROTECT_IMPORT_BINDING(CN, SN) \ S48_GC_PROTECT_GLOBAL(CN); \ CN = s48_get_imported_binding(SN); +/* scheme record types */ +SCX_DECLARE_STATIC_S48VAL(scx_xftpattern_record_type); +SCX_DECLARE_STATIC_S48VAL(scx_xftfont_record_type); +SCX_DECLARE_STATIC_S48VAL(scx_xftdraw_record_type); +SCX_DECLARE_STATIC_S48VAL(scx_xftcolor_record_type); +SCX_DECLARE_STATIC_S48VAL(scx_xftobjectset_record_type); +SCX_DECLARE_STATIC_S48VAL(scx_xftfontset_record_type); + /* C values exported to scheme */ -static s48_value scx_XftResultMatch = S48_FALSE; -static s48_value scx_XftResultNoMatch = S48_FALSE; -static s48_value scx_XftResultTypeMismatch = S48_FALSE; -static s48_value scx_XftResultNoId = S48_FALSE; -static s48_value scx_XftVersionMajor = S48_FALSE; -static s48_value scx_XftVersionMinor = S48_FALSE; +SCX_DECLARE_STATIC_S48VAL(scx_XftResultMatch); +SCX_DECLARE_STATIC_S48VAL(scx_XftResultNoMatch); +SCX_DECLARE_STATIC_S48VAL(scx_XftResultTypeMismatch); +SCX_DECLARE_STATIC_S48VAL(scx_XftResultNoId); +SCX_DECLARE_STATIC_S48VAL(scx_XftVersionMajor); +SCX_DECLARE_STATIC_S48VAL(scx_XftVersionMinor); + +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_family); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_style); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_slant); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_weight); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_size); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_pixel_size); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_encoding); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_spacing); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_foundry); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_core); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_antialias); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_xlfd); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_file); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_index); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_rasterizer); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_outline); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_scalable); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_rgba); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_scale); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_render); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_minspace); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_dpi); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_char_width); +SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_char_height); #define XFT_REC_ACCESSOR_MAKER(FN, TN, RN) \ s48_value FN(TN *p) \ diff --git a/scheme/libs/libs-interfaces.scm b/scheme/libs/libs-interfaces.scm index 57abf6f..3cd8c0c 100644 --- a/scheme/libs/libs-interfaces.scm +++ b/scheme/libs/libs-interfaces.scm @@ -41,7 +41,9 @@ scx-xft-draw-display scx-xft-draw-drawable scx-xft-draw-colormap - scx-xft-draw-visual)) + scx-xft-draw-visual + (xft-pattern-object :syntax) + xft-pattern-object-elements)) (define-interface xrender-interface (export diff --git a/scheme/libs/libs-packages.scm b/scheme/libs/libs-packages.scm index b748406..93ff451 100644 --- a/scheme/libs/libs-packages.scm +++ b/scheme/libs/libs-packages.scm @@ -11,6 +11,7 @@ xlib signals define-record-types + finite-types srfi-1 external-calls) (files xft)) diff --git a/scheme/libs/xft.scm b/scheme/libs/xft.scm index f440845..808fea2 100644 --- a/scheme/libs/xft.scm +++ b/scheme/libs/xft.scm @@ -45,6 +45,44 @@ (define-exported-binding "xft-fontset" :xft-fontset) +(define-syntax lookup-shared-valued + (syntax-rules () + ((lookup-shared-valued str) + (shared-binding-ref + (lookup-imported-binding str))))) + +(define-finite-type xft-pattern-object :xft-pattern-object + (id) + xft-pattern-object? + xft-pattern-object-elements + xft-pattern-object-name + xft-pattern-object-index + (id xft-pattern-object-id) + ((family (lookup-shared-valued "scx-xft-pattern-family")) + (style (lookup-shared-valued "scx-xft-pattern-style")) + (slant (lookup-shared-valued "scx-xft-pattern-slant")) + (weight (lookup-shared-valued "scx-xft-pattern-weight")) + (size (lookup-shared-valued "scx-xft-pattern-size")) + (pixel-size (lookup-shared-valued "scx-xft-pattern-pixel-size")) + (encoding (lookup-shared-valued "scx-xft-pattern-encoding")) + (spacing (lookup-shared-valued "scx-xft-pattern-spacing")) + (foundry (lookup-shared-valued "scx-xft-pattern-foundry")) + (core (lookup-shared-valued "scx-xft-pattern-core")) + (antialias (lookup-shared-valued "scx-xft-pattern-antialias")) + (xlfd (lookup-shared-valued "scx-xft-pattern-xlfd")) + (file (lookup-shared-valued "scx-xft-pattern-file")) + (index (lookup-shared-valued "scx-xft-pattern-index")) + (rasterizer (lookup-shared-valued "scx-xft-pattern-rasterizer")) + (outline (lookup-shared-valued "scx-xft-pattern-outline")) + (scalable (lookup-shared-valued "scx-xft-pattern-scalable")) + (rgba (lookup-shared-valued "scx-xft-pattern-rgba")) + (scale (lookup-shared-valued "scx-xft-pattern-scale")) + (render (lookup-shared-valued "scx-xft-pattern-render")) + (minspace (lookup-shared-valued "scx-xft-pattern-minspace")) + (dpi (lookup-shared-valued "scx-xft-pattern-dpi")) + (char-width (lookup-shared-valued "scx-xft-pattern-char-width")) + (char-height (lookup-shared-valued "scx-xft-pattern-char-height")))) + ;;; add finalizers (define (make-xft-pattern) @@ -57,6 +95,14 @@ (add-finalizer! copy scx-xft-pattern-destroy) copy)) +(define (scx-xft-pattern-get xft-pattern xft-pattern-object id) + (scx-xft-pattern-get-internal + xft-pattern (xft-pattern-object-id xft-pattern-object) id)) + +(define (scx-xft-pattern-add xft-pattern xft-pattern-object value append?) + (scx-xft-pattern-add-internal + xft-pattern (xft-pattern-object-id xft-pattern-object) value append?)) + (define (scx-xft-font-match display screen xft-pattern) (call-with-values (lambda () @@ -98,6 +144,10 @@ (add-finalizer! xft-objectset scx-xft-objectset-destroy) xft-objectset)) +(define (scx-xft-objectset-add xft-objectset xft-pattern-object) + (scx-xft-objectset-add-internal + xft-objectset (xft-pattern-object-id xft-pattern-object))) + (define (scx-xft-draw-display xft-draw) (let ((display (scx-xft-draw-display-internal xft-draw))) (if display @@ -213,11 +263,11 @@ (xft-pattern) "scx_XftPatternDuplicate") -(import-lambda-definition scx-xft-pattern-get +(import-lambda-definition scx-xft-pattern-get-internal (xft-pattern object id) "scx_XftPatternGet") -(import-lambda-definition scx-xft-pattern-add +(import-lambda-definition scx-xft-pattern-add-internal (xft-pattern object value append?) "scx_XftPatternAdd") @@ -297,7 +347,7 @@ (xft-objectset) "scx_XftObjectSetDestroy") -(import-lambda-definition scx-xft-objectset-add +(import-lambda-definition scx-xft-objectset-add-internal (xft-objectset object) "scx_XftObjectSetAdd")