From 71e6e638cba09643fca5dccd1b7295b7db0def06 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Tue, 31 Dec 2019 16:18:54 +0100 Subject: [PATCH] Generic function for unwrapping foreign records --- irrlicht/device.scm | 2 +- irrlicht/dimension2d.scm | 2 -- irrlicht/gui.scm | 3 +-- irrlicht/rect.scm | 2 -- irrlicht/util.scm | 8 ++++++-- 5 files changed, 8 insertions(+), 9 deletions(-) diff --git a/irrlicht/device.scm b/irrlicht/device.scm index 051cddd..c773dbc 100644 --- a/irrlicht/device.scm +++ b/irrlicht/device.scm @@ -52,7 +52,7 @@ ('opengl ffi-video:EDT_OPENGL) ('count ffi-video:EDT_COUNT)))) (let ((device (ffi:create-device driver - (dimension2d->pointer window-size) + (foreign-record->pointer window-size) bits (bool->integer fullscreen) (bool->integer stencilbuffer) diff --git a/irrlicht/dimension2d.scm b/irrlicht/dimension2d.scm index 6b03cd0..7eb8cfd 100644 --- a/irrlicht/dimension2d.scm +++ b/irrlicht/dimension2d.scm @@ -24,7 +24,6 @@ #:export (dimension2d make-dimension2d dimension2d? - dimension2d->pointer dimension2d-width dimension2d-height)) @@ -32,6 +31,5 @@ (define-foreign-record-type dimension2d (make-dimension2d width height) dimension2d? - dimension2d->pointer (width uint32 dimension2d-width) (height uint32 dimension2d-height)) diff --git a/irrlicht/gui.scm b/irrlicht/gui.scm index 495a9c7..bd5eede 100644 --- a/irrlicht/gui.scm +++ b/irrlicht/gui.scm @@ -23,7 +23,6 @@ #:use-module (system foreign) #:use-module ((irrlicht bindings core) #:prefix ffi-core:) #:use-module ((irrlicht bindings gui) #:prefix ffi-gui:) - #:use-module (irrlicht rect) #:use-module (irrlicht util) #:export (add-static-text! gui-draw-all @@ -38,7 +37,7 @@ (fill-background #f)) (ffi-gui:add-static-text gui-env (string->pointer text) - (rect->pointer rectangle) + (foreign-record->pointer rectangle) (bool->integer border) (bool->integer word-wrap) parent diff --git a/irrlicht/rect.scm b/irrlicht/rect.scm index f481a7c..b73f32d 100644 --- a/irrlicht/rect.scm +++ b/irrlicht/rect.scm @@ -24,7 +24,6 @@ #:export (rect make-rect rect? - rect->pointer rect-x rect-y rect-x2 @@ -34,7 +33,6 @@ (define-foreign-record-type rect (make-rect x y x2 y2) rect? - rect->pointer (x int32 rect-x) (y int32 rect-y) (x2 int32 rect-x2) diff --git a/irrlicht/util.scm b/irrlicht/util.scm index e7c8641..efa5ba7 100644 --- a/irrlicht/util.scm +++ b/irrlicht/util.scm @@ -25,7 +25,8 @@ #:export (bool->integer integer->bool define-foreign - define-foreign-record-type)) + define-foreign-record-type + foreign-record->pointer)) (define (bool->integer var) (if var 1 0)) @@ -79,7 +80,7 @@ (iota (length field-specs)))) (syntax-case x () - ((_ name (make-name make-arg ...) predicate? unwrap-record field-spec ...) + ((_ name (make-name make-arg ...) predicate? field-spec ...) (with-syntax (((type-id ...) (field-types #'(field-spec ...))) ((field-name ...) (field-names #'(field-spec ...))) (((getter getter-id) ...) (field-getters #'(field-spec ...))) @@ -133,3 +134,6 @@ (else #f)))) (if procedure (apply procedure bv 0 value '())))) + +(define (foreign-record->pointer record) + (struct-ref record 0)) -- 2.39.5