(define-record-type xft-pattern :xft-pattern (really-make-xft-pattern c-pointer) xft-pattern? (c-pointer xft-pattern-c-pointer)) (define-exported-binding "xft-pattern" :xft-pattern) (define-record-type xft-font :xft-font (make-xft-font x-pointer) xft-font? (x-pointer xft-font-x-pointer)) (define-exported-binding "xft-font" :xft-font) (define-record-type xft-draw :xft-draw (make-xft-draw c-pointer) xft-dra w? (c-pointer xft-draw-c-pointer)) (define-exported-binding "xft-draw" :xft-draw) (define-record-type xft-color :xft-color (make-xft-color c-pointer) xft-color? (c-pointer xft-color-c-pointer)) (define-exported-binding "xft-color" :xft-color) (define-record-type xft-objectset :xft-objectset (make-xft-objectset c-pointer) xft-objectset? (c-pointer xft-objectset-c-pointer)) (define-exported-binding "xft-objectset" :xft-objectset) (define-record-type xft-fontset :xft-fontset (make-xft-fontset c-pointer) xft-fontset? (c-pointer xft-fontset-c-pointer)) (define-exported-binding "xft-fontset" :xft-fontset) ;;; add finalizers (define (make-xft-pattern) (let ((xft-pattern (scx-xft-pattern-create))) (add-finalizer! xft-pattern scx-xft-pattern-destroy) xft-pattern)) (define (scx-xft-pattern-duplicate xft-pattern) (let ((copy (scx-xft-pattern-duplicate-internal xft-pattern))) (add-finalizer! copy scx-xft-pattern-destroy) copy)) (define (scx-xft-font-match display screen xft-pattern) (call-with-values (lambda (result xft-pattern) (add-finalizer! xft-pattern scx-xft-pattern-destroy) (values result xft-pattern)) (lambda () (scx-xft-font-match-internal display screen xft-pattern)))) (define (scx-xft-font-open-pattern display xft-pattern) (let ((xft-font (scx-xft-font-open-pattern-internal display xft-pattern))) (add-finalizer! xft-font scx-xft-font-close) xft-font)) (define (scx-xft-font-open-name display screen name) (let ((xft-font (scx-xft-font-open-name-internal display screen name))) (add-finalizer! xft-font scx-xft-font-close) xft-font)) (define (scx-xft-font-open-xlfd display screen name) (let ((xft-font (scx-xft-font-open-xlfd-internal display screen name))) (add-finalizer! xft-font scx-xft-font-close) xft-font)) (define (scx-xft-draw-create display drawable visual colormap) (let ((xft-draw (scx-xft-draw-create-internal display drawable visual colormap))) (add-finalizer! xft-draw scx-xft-draw-destroy) xft-draw)) (define (scx-xft-draw-create-bitmap display drawable) (let ((xft-draw (scx-xft-draw-create-bitmap-internal display drawable))) (add-finalizer! xft-draw scx-xft-draw-destroy) xft-draw)) (define (make-xft-objectset) (let ((xft-objectset (scx-xft-objectset-create))) (add-finalizer! xft-objectset scx-xft-objectset-destroy) xft-objectset)) (define (scx-xft-draw-display xft-draw) (let ((display (scx-xft-draw-display-internal xft-draw))) (if display display (error "XftDrawDisplay() unavailable in this version of Xft")))) (define (scx-xft-draw-drawable xft-draw) (let ((drawable (scx-xft-draw-drawable-internal xft-draw))) (if drawable drawable (error "XftDrawDrawable() unavailable in this version of Xft")))) (define (scx-xft-draw-colormap xft-draw) (let ((colormap (scx-xft-draw-colormap-internal xft-draw))) (if colormap colormap (error "XftDrawColormap() unavailable in this version of Xft")))) (define (scx-xft-draw-visual xft-draw) (let ((visual (scx-xft-draw-visual-internal xft-draw))) (if visual visual (error "XftDrawVisual() unavailable in this version of Xft")))) ;;; import functions from C code (import-lambda-definition scx-xft-pattern-create () "scx_XftPatternCreate") (import-lambda-definition scx-xft-pattern-duplicate-internal (xft-pattern) "scx_XftPatternDuplicate") (import-lambda-definition scx-xft-pattern-get (xft-pattern object id) "scx_XftPatternGet") (import-lambda-definition scx-xft-pattern-add (xft-pattern object value append?) "scx_XftPatternAdd") (import-lambda-definition scx-xft-font-match-internal (display screen xft-pattern) "scx_XftFontMatch") (import-lambda-definition scx-xft-font-open-pattern-internal (display xft-pattern) "scx_XftFontOpenPattern") (import-lambda-definition scx-xft-font-open-name-internal (display screen name) "scx_XftFontOpenName") (import-lambda-definition scx-xft-font-open-xlfd-internal (display screen xlfd-name) "scx_XftFontOpenXlfd") (import-lambda-definition scx-xft-font-close (display xft-font) "scx_XftFontClose") (import-lambda-definition scx-xft-draw-create-internal (display drawable visual colormap) "scx_XftDrawCreate") (import-lambda-definition scx-xft-draw-create-bitmap-internal (display drawable) "scx_XftDrawCreateBitmap") (import-lambda-definition scx-xft-draw-change (xft-draw drawable) "scx_XftDrawChange") (import-lambda-definition scx-xft-draw-display-internal (xft-draw) "scx_XftDrawDisplay") (import-lambda-definition scx-xft-draw-drawable-internal (xft-draw) "scx_XftDrawDrawable") (import-lambda-definition scx-xft-draw-colormap-internal (xft-draw) "scx_XftDrawColormap") (import-lambda-definition scx-xft-draw-visual-internal (xft-draw) "scx_XftDrawVisual") (import-lambda-definition scx-xft-draw-destroy (xft-draw) "scx_XftDrawDestroy") (import-lambda-definition scx-xft-text-extents-8bit (display xft-font string) "scx_XftTextExtents8") (import-lambda-definition scx-xft-draw-string-8bit (xft-draw xft-color xft-font x y string) "scx_XftDrawString8") (import-lambda-definition scx-xft-draw-rect (xft-draw xft-color x y w h) "scx_XftDrawRect") (import-lambda-definition scx-xft-draw-set-clip (xft-draw region) "scx_XftDrawSetClip") (import-lambda-definition scx-xft-objectset-create () "scx_XftObjectSetCreate") (import-lambda-definition scx-xft-objectset-add (xft-objectset object) "scx_XftObjectSetAdd") (import-lambda-definition scx-xft-list-fonts-pattern-objects (diplay screen xft-pattern xft-objectset) "scx_XftListFontsPatternObjects")