diff --git a/fontconfig/bindings.scm b/fontconfig/bindings.scm index b547e28..29ff6e5 100644 --- a/fontconfig/bindings.scm +++ b/fontconfig/bindings.scm @@ -74,6 +74,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES." (define fontconfig-pattern-destroy (dynamic-func "FcPatternDestroy" (dynamic-link %libfontconfig))) +;; (define-foreign fontconfig-pattern-destroy +;; void "FcPatternDestroy" '(*)) + (define-foreign fontconfig-pattern-add-string int "FcPatternAddString" '(* * *)) diff --git a/fontconfig/object-set.scm b/fontconfig/object-set.scm index 855ba41..8829dd5 100644 --- a/fontconfig/object-set.scm +++ b/fontconfig/object-set.scm @@ -24,16 +24,17 @@ unwrap-object-set object-set-add!)) -(define-wrapped-pointer-type - object-set? - wrap-object-set unwrap-object-set - (lambda (pattern port) - (format port "#"))) +(define + (make-record-type ' '(ptr))) +(define %make-object-set (record-constructor )) +(define unwrap-object-set (record-accessor 'ptr)) +(define (wrap-object-set ptr) + (%make-object-set + (make-pointer (pointer-address ptr) ffi:fontconfig-object-set-destroy))) (define (make-object-set) (let* ((ptr (ffi:fontconfig-object-set-create)) (object-set (wrap-object-set ptr))) - (set-pointer-finalizer! ptr ffi:fontconfig-object-set-destroy) object-set)) (define (object-set-add! os attr) diff --git a/fontconfig/pattern.scm b/fontconfig/pattern.scm index 6c0de37..99fafdf 100644 --- a/fontconfig/pattern.scm +++ b/fontconfig/pattern.scm @@ -47,10 +47,14 @@ histing verticallayout autohint outline scalable minspace embolden embeddedbitmap decorative)) -(define-wrapped-pointer-type - pattern? - wrap-pattern unwrap-pattern - (lambda (pattern port) (format port "#"))) +(define + (make-record-type ' '(ptr))) +(define %make-pattern (record-constructor )) +(define unwrap-pattern (record-accessor 'ptr)) + +(define (wrap-pattern ptr) + (%make-pattern + (make-pointer (pointer-address ptr) ffi:fontconfig-pattern-destroy))) (define symbol->pointer (compose string->pointer symbol->string)) @@ -86,7 +90,6 @@ (if (null-pointer? ptr) (error "make-pattern" "failed to create pattern") (wrap-pattern ptr)))) - (set-pointer-finalizer! ptr ffi:fontconfig-pattern-destroy) (map (lambda (args) (apply (match args (((? bool? attr) value) pattern-add-bool)