pattern.scm, bindings.scm: Use make-pointer.
* fontconfig/pattern.scm: Replace define-wrapped-pointer-type with make-pointer. * fontconfig/object-set.scm: Ditto.master
parent
bbc3a6bb9a
commit
a37ce1347a
|
@ -74,6 +74,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
|
||||||
(define fontconfig-pattern-destroy
|
(define fontconfig-pattern-destroy
|
||||||
(dynamic-func "FcPatternDestroy" (dynamic-link %libfontconfig)))
|
(dynamic-func "FcPatternDestroy" (dynamic-link %libfontconfig)))
|
||||||
|
|
||||||
|
;; (define-foreign fontconfig-pattern-destroy
|
||||||
|
;; void "FcPatternDestroy" '(*))
|
||||||
|
|
||||||
(define-foreign fontconfig-pattern-add-string
|
(define-foreign fontconfig-pattern-add-string
|
||||||
int "FcPatternAddString" '(* * *))
|
int "FcPatternAddString" '(* * *))
|
||||||
|
|
||||||
|
|
|
@ -24,16 +24,17 @@
|
||||||
unwrap-object-set
|
unwrap-object-set
|
||||||
object-set-add!))
|
object-set-add!))
|
||||||
|
|
||||||
(define-wrapped-pointer-type <object-set>
|
(define <object-set>
|
||||||
object-set?
|
(make-record-type '<object-set> '(ptr)))
|
||||||
wrap-object-set unwrap-object-set
|
(define %make-object-set (record-constructor <object-set>))
|
||||||
(lambda (pattern port)
|
(define unwrap-object-set (record-accessor <object-set> 'ptr))
|
||||||
(format port "#<object-set>")))
|
(define (wrap-object-set ptr)
|
||||||
|
(%make-object-set
|
||||||
|
(make-pointer (pointer-address ptr) ffi:fontconfig-object-set-destroy)))
|
||||||
|
|
||||||
(define (make-object-set)
|
(define (make-object-set)
|
||||||
(let* ((ptr (ffi:fontconfig-object-set-create))
|
(let* ((ptr (ffi:fontconfig-object-set-create))
|
||||||
(object-set (wrap-object-set ptr)))
|
(object-set (wrap-object-set ptr)))
|
||||||
(set-pointer-finalizer! ptr ffi:fontconfig-object-set-destroy)
|
|
||||||
object-set))
|
object-set))
|
||||||
|
|
||||||
(define (object-set-add! os attr)
|
(define (object-set-add! os attr)
|
||||||
|
|
|
@ -47,10 +47,14 @@
|
||||||
histing verticallayout autohint outline scalable
|
histing verticallayout autohint outline scalable
|
||||||
minspace embolden embeddedbitmap decorative))
|
minspace embolden embeddedbitmap decorative))
|
||||||
|
|
||||||
(define-wrapped-pointer-type <pattern>
|
(define <pattern>
|
||||||
pattern?
|
(make-record-type '<pattern> '(ptr)))
|
||||||
wrap-pattern unwrap-pattern
|
(define %make-pattern (record-constructor <pattern>))
|
||||||
(lambda (pattern port) (format port "#<pattern>")))
|
(define unwrap-pattern (record-accessor <pattern> 'ptr))
|
||||||
|
|
||||||
|
(define (wrap-pattern ptr)
|
||||||
|
(%make-pattern
|
||||||
|
(make-pointer (pointer-address ptr) ffi:fontconfig-pattern-destroy)))
|
||||||
|
|
||||||
(define symbol->pointer
|
(define symbol->pointer
|
||||||
(compose string->pointer symbol->string))
|
(compose string->pointer symbol->string))
|
||||||
|
@ -86,7 +90,6 @@
|
||||||
(if (null-pointer? ptr)
|
(if (null-pointer? ptr)
|
||||||
(error "make-pattern" "failed to create pattern")
|
(error "make-pattern" "failed to create pattern")
|
||||||
(wrap-pattern ptr))))
|
(wrap-pattern ptr))))
|
||||||
(set-pointer-finalizer! ptr ffi:fontconfig-pattern-destroy)
|
|
||||||
(map (lambda (args)
|
(map (lambda (args)
|
||||||
(apply (match args
|
(apply (match args
|
||||||
(((? bool? attr) value) pattern-add-bool)
|
(((? bool? attr) value) pattern-add-bool)
|
||||||
|
|
Loading…
Reference in New Issue