#lang racket/base (require "loadlib.rkt" "object.rkt" "gtype.rkt" ffi/unsafe racket/list) (define-cstruct _gparam ([instance _pointer] [name _string] [_flags _int] [gtype _gtype] [owner-gtype _gtype])) (define-gobject* g-object-class-find-property (_fun _pointer _string -> _pointer)) (define (property-gtype object name) (define param (g-object-class-find-property (ptr-ref object _pointer) name)) (unless param (raise-argument-error 'property "property name" name)) (gparam-gtype (ptr-ref param _gparam))) (set!-set-properties! (λ (object properties) (define (make-type gtypes) (_cprocedure (append (list _pointer) (for*/list ([type (in-list gtypes)] [i (in-range 2)]) (if (= i 1) (gtype->ffi type) _string)) (list _pointer)) _void)) (define-values (type args) (let loop ([properties properties] [gtypes null] [args null]) (cond [(null? properties) (values (make-type (reverse gtypes)) (reverse (cons #f args)))] [(and (pair? properties) (pair? (cdr properties))) (define arg (c-name (first properties))) (define val (second properties)) (loop (cddr properties) (cons (property-gtype object arg) gtypes) (cons val (cons arg args)))]))) (apply (get-ffi-obj "g_object_set" #f type) object args))) (set!-get-properties (λ (object properties) (define (make-type gtypes) (_cprocedure (append (list _pointer) (for*/list ([type (in-list gtypes)] [i (in-range 2)]) (if (= i 1) _pointer _string)) (list _pointer)) _void)) (define-values (type arg-types args) (let loop ([properties properties] [gtypes null] [arg-types null] [args null]) (cond [(null? properties) (values (make-type (reverse gtypes)) (reverse arg-types) (reverse (cons #f args)))] [else (define arg (c-name (first properties))) (define gtype (property-gtype object arg)) (define arg-type (gtype->ffi gtype)) (define val (malloc arg-type)) (loop (cdr properties) (cons gtype gtypes) (cons arg-type arg-types) (cons val (cons arg args)))]))) (apply (get-ffi-obj "g_object_get" #f type) object args) (apply values (let loop ([vals null] [args args] [arg-types arg-types]) (cond [(null? arg-types) (reverse vals)] [else (define val (ptr-ref (second args) (car arg-types))) (loop (cons val vals) (cddr args) (cdr arg-types))])))))