+ export some Xft constants to Scheme
+ finite types for some Xft pattern objects: xft-weight, xft-slant, xft-spacing, xft-rgba + functions for translating Xft constants to finite types + make XftPatternGet/Add() use the finite types + fixed a serious bug in scx_XftPatternAdd
This commit is contained in:
eknauel
parent
9d13fd2930
commit
315948f857
38
c/libs/xft.c
38
c/libs/xft.c
|
|
@ -107,7 +107,7 @@ s48_value scx_XftPatternAdd(s48_value sxp, s48_value sobj,
|
|||
p = scx_extract_xftpattern(sxp);
|
||||
obj = s48_extract_integer(sobj);
|
||||
append = S48_TRUE_P(sappend);
|
||||
tbl = lookup_pattern_property_by_id(sobj);
|
||||
tbl = lookup_pattern_property_by_id(obj);
|
||||
|
||||
switch (tbl->type) {
|
||||
case SCX_XFT_STRING:
|
||||
|
|
@ -539,6 +539,42 @@ void scx_xft_init(void)
|
|||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-char-height", scx_xft_pattern_char_height,
|
||||
SCX_XFT_CHAR_HEIGHT);
|
||||
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-weight-light", scx_xft_weight_light,
|
||||
XFT_WEIGHT_LIGHT);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-weight-medium", scx_xft_weight_medium,
|
||||
XFT_WEIGHT_MEDIUM);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-weight-demibold", scx_xft_weight_demibold,
|
||||
XFT_WEIGHT_DEMIBOLD);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-weight-bold", scx_xft_weight_bold,
|
||||
XFT_WEIGHT_BOLD);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-weight-black", scx_xft_weight_black,
|
||||
XFT_WEIGHT_BLACK);
|
||||
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-slant-roman", scx_xft_slant_roman,
|
||||
XFT_SLANT_ROMAN);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-slant-italic", scx_xft_slant_italic,
|
||||
XFT_SLANT_ITALIC);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-slant-oblique", scx_xft_slant_oblique,
|
||||
XFT_SLANT_OBLIQUE);
|
||||
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-spacing-proportional", scx_xft_spacing_proportional,
|
||||
XFT_PROPORTIONAL);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-spacing-mono", scx_xft_spacing_mono,
|
||||
XFT_MONO);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-spacing-charcell", scx_xft_spacing_charcell,
|
||||
XFT_CHARCELL);
|
||||
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-rgba-none", scx_xft_rgba_none,
|
||||
XFT_RGBA_NONE);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-rgba-rgb", scx_xft_rgba_rgb,
|
||||
XFT_RGBA_RGB);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-rgba-bgr", scx_xft_rgba_bgr,
|
||||
XFT_RGBA_BGR);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-rgba-vrgb", scx_xft_rgba_vrgb,
|
||||
XFT_RGBA_VRGB);
|
||||
SCX_EXPORT_INTEGER_TO_S48("scx-xft-rgba-vbgr", scx_xft_rgba_vbgr,
|
||||
XFT_RGBA_VBGR);
|
||||
|
||||
S48_EXPORT_FUNCTION(scx_XftPatternCreate);
|
||||
S48_EXPORT_FUNCTION(scx_XftPatternDestroy);
|
||||
S48_EXPORT_FUNCTION(scx_XftPatternDuplicate);
|
||||
|
|
|
|||
20
c/libs/xft.h
20
c/libs/xft.h
|
|
@ -142,6 +142,26 @@ 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);
|
||||
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_weight_light);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_weight_medium);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_weight_demibold);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_weight_bold);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_weight_black);
|
||||
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_slant_roman);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_slant_italic);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_slant_oblique);
|
||||
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_spacing_proportional);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_spacing_mono);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_spacing_charcell);
|
||||
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_none);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_rgb);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_bgr);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_vrgb);
|
||||
SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_vbgr);
|
||||
|
||||
#define XFT_REC_ACCESSOR_MAKER(FN, TN, RN) \
|
||||
s48_value FN(TN *p) \
|
||||
{ \
|
||||
|
|
|
|||
|
|
@ -42,13 +42,36 @@
|
|||
scx-xft-draw-drawable
|
||||
scx-xft-draw-colormap
|
||||
scx-xft-draw-visual
|
||||
(xft-pattern-object :syntax)
|
||||
xft-pattern-object-elements
|
||||
|
||||
|
||||
scx-xft-result-match?
|
||||
scx-xft-result-no-match?
|
||||
scx-xft-result-type-mismatch?
|
||||
scx-xft-result-no-id?))
|
||||
scx-xft-result-no-id?
|
||||
|
||||
(xft-pattern-object :syntax)
|
||||
xft-pattern-object?
|
||||
xft-pattern-object-elements
|
||||
xft-pattern-object-name
|
||||
|
||||
(xft-weight :syntax)
|
||||
xft-weight?
|
||||
xft-weight-elements
|
||||
xft-weight-name
|
||||
|
||||
(xft-slant :syntax)
|
||||
xft-slant?
|
||||
xft-slant-elements
|
||||
xft-slant-name
|
||||
|
||||
(xft-spacing :syntax)
|
||||
xft-spacing?
|
||||
xft-spacing-elements
|
||||
xft-spacing-name
|
||||
|
||||
(xft-rgba :syntax)
|
||||
xft-rgba?
|
||||
xft-rgba-elements
|
||||
xft-rgba-name))
|
||||
|
||||
(define-interface xrender-interface
|
||||
(export
|
||||
|
|
|
|||
|
|
@ -83,6 +83,95 @@
|
|||
(char-width (lookup-shared-valued "scx-xft-pattern-char-width"))
|
||||
(char-height (lookup-shared-valued "scx-xft-pattern-char-height"))))
|
||||
|
||||
(define-finite-type xft-weight :xft-weight
|
||||
(id)
|
||||
xft-weight?
|
||||
xft-weight-elements
|
||||
xft-weight-name
|
||||
xft-weight-index
|
||||
(id xft-weight-id)
|
||||
((light (lookup-shared-valued "scx-xft-weight-light"))
|
||||
(medium (lookup-shared-valued "scx-xft-weight-medium"))
|
||||
(demibold (lookup-shared-valued "scx-xft-weight-demibold"))
|
||||
(bold (lookup-shared-valued "scx-xft-weight-bold"))
|
||||
(black (lookup-shared-valued "scx-xft-weight-black"))))
|
||||
|
||||
(define-finite-type xft-slant :xft-slant
|
||||
(id)
|
||||
xft-slant?
|
||||
xft-slant-elements
|
||||
xft-slant-name
|
||||
xft-slant-index
|
||||
(id xft-slant-id)
|
||||
((roman (lookup-shared-valued "scx-xft-slant-roman"))
|
||||
(italic (lookup-shared-valued "scx-xft-slant-italic"))
|
||||
(oblique (lookup-shared-valued "scx-xft-slant-oblique"))))
|
||||
|
||||
(define-finite-type xft-spacing :xft-spacing
|
||||
(id)
|
||||
xft-spacing?
|
||||
xft-spacing-elements
|
||||
xft-spacing-name
|
||||
xft-spacing-index
|
||||
(id xft-spacing-id)
|
||||
((proportional (lookup-shared-valued "scx-xft-spacing-proportional"))
|
||||
(mono (lookup-shared-valued "scx-xft-spacing-mono"))
|
||||
(charcell (lookup-shared-valued "scx-xft-spacing-charcell"))))
|
||||
|
||||
(define-finite-type xft-rgba :xft-rgba
|
||||
(id)
|
||||
xft-rgba?
|
||||
xft-rgba-elements
|
||||
xft-rgba-name
|
||||
xft-rgba-index
|
||||
(id xft-rgba-id)
|
||||
((none (lookup-shared-valued "scx-xft-rgba-none"))
|
||||
(rgb (lookup-shared-valued "scx-xft-rgba-rgb"))
|
||||
(bgr (lookup-shared-valued "scx-xft-rgba-bgr"))
|
||||
(vrgb (lookup-shared-valued "scx-xft-rgba-vrgb"))
|
||||
(vbgr (lookup-shared-valued "scx-xft-rgba-vbgr"))))
|
||||
|
||||
(define (make-finite-type-alist elements id-proc)
|
||||
(map (lambda (e)
|
||||
(cons (id-proc e) e))
|
||||
(vector->list elements)))
|
||||
|
||||
(define xft-weight-id->xft-weight
|
||||
(let ((alist
|
||||
(make-finite-type-alist xft-weight-elements xft-weight-id)))
|
||||
(lambda (id)
|
||||
(cond
|
||||
((assoc id alist) => cdr)
|
||||
(else
|
||||
(error "scx: internal error. Could not map weight id to finite type"))))))
|
||||
|
||||
(define xft-slant-id->xft-slant
|
||||
(let ((alist
|
||||
(make-finite-type-alist xft-slant-elements xft-slant-id)))
|
||||
(lambda (id)
|
||||
(cond
|
||||
((assoc id alist) => cdr)
|
||||
(else
|
||||
(error "scx: internal error. Could not map slant id to finite type"))))))
|
||||
|
||||
(define xft-spacing-id->xft-spacing
|
||||
(let ((alist
|
||||
(make-finite-type-alist xft-spacing-elements xft-spacing-id)))
|
||||
(lambda (id)
|
||||
(cond
|
||||
((assoc id alist) => cdr)
|
||||
(else
|
||||
(error "scx: internal error. Could not map spacing id to finite type"))))))
|
||||
|
||||
(define xft-rgba-id->xft-rgba
|
||||
(let ((alist
|
||||
(make-finite-type-alist xft-rgba-elements xft-rgba-id)))
|
||||
(lambda (id)
|
||||
(cond
|
||||
((assoc id alist) => cdr)
|
||||
(else
|
||||
(error "scx: internal error. Could not map rgba id to finite type"))))))
|
||||
|
||||
;;; add finalizers
|
||||
|
||||
(define (make-xft-pattern)
|
||||
|
|
@ -95,13 +184,42 @@
|
|||
(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-pattern-get pattern object id)
|
||||
(let ((object-id (xft-pattern-object-id object)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(apply values
|
||||
(scx-xft-pattern-get-internal pattern object-id id)))
|
||||
(lambda (code value)
|
||||
(values code
|
||||
(cond
|
||||
((not (scx-xft-result-match? code))
|
||||
#f)
|
||||
((equal? object (xft-pattern-object weight))
|
||||
(xft-weight-id->xft-weight value))
|
||||
((equal? object (xft-pattern-object slant))
|
||||
(xft-slant-id->xft-slant value))
|
||||
((equal? object (xft-pattern-object spacing))
|
||||
(xft-spacing-id->xft-spacing value))
|
||||
((equal? object (xft-pattern-object rgba))
|
||||
(xft-rgba-id->xft-rgba value))
|
||||
(else value)))))))
|
||||
|
||||
(define (scx-xft-pattern-add pattern object value append?)
|
||||
(let* ((object-id (xft-pattern-object-id object))
|
||||
(call (lambda (value)
|
||||
(scx-xft-pattern-add-internal
|
||||
pattern object-id value append?))))
|
||||
(cond
|
||||
((equal? object (xft-pattern-object weight))
|
||||
(call (xft-weight-id value)))
|
||||
((equal? object (xft-pattern-object slant))
|
||||
(call (xft-slant-id value)))
|
||||
((equal? object (xft-pattern-object spacing))
|
||||
(call (xft-spacing-id value)))
|
||||
((equal? object (xft-pattern-object rgba))
|
||||
(call (xft-rgba-id value)))
|
||||
(else (call value)))))
|
||||
|
||||
(define (scx-xft-font-match display screen xft-pattern)
|
||||
(call-with-values
|
||||
|
|
|
|||
Loading…
Reference in New Issue